YAPC::EU 2018 Glasgow Update!
This commit is contained in:
Ingy döt Net
parent
22f33d4004
commit
4e2d22a71d
1170 changed files with 15042 additions and 3047 deletions
27
Task/Quaternion-type/Factor/quaternion-type.factor
Normal file
27
Task/Quaternion-type/Factor/quaternion-type.factor
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
USING: generalizations io kernel locals math.quaternions
|
||||
math.vectors prettyprint sequences ;
|
||||
IN: rosetta-code.quaternion-type
|
||||
|
||||
: show ( quot -- )
|
||||
[ unparse 2 tail but-last "= " append write ] [ call . ] bi
|
||||
; inline
|
||||
|
||||
: 2show ( quots -- )
|
||||
[ 2curry show ] map-compose [ call ] each ; inline
|
||||
|
||||
: q+n ( q n -- q+n ) n>q q+ ;
|
||||
|
||||
[let
|
||||
{ 1 2 3 4 } 7 { 2 3 4 5 } { 3 4 5 6 } :> ( q r q1 q2 )
|
||||
q [ norm ]
|
||||
q [ vneg ]
|
||||
q [ qconjugate ]
|
||||
[ curry show ] 2tri@
|
||||
{
|
||||
[ q r [ q+n ] ]
|
||||
[ q r [ q*n ] ]
|
||||
[ q1 q2 [ q+ ] ]
|
||||
[ q1 q2 [ q* ] ]
|
||||
[ q2 q1 [ q* ] ]
|
||||
} 2show
|
||||
]
|
||||
|
|
@ -1,8 +1,10 @@
|
|||
import Control.Monad
|
||||
import Control.Arrow
|
||||
import Data.List
|
||||
import Control.Monad (join)
|
||||
|
||||
data Quaternion = Q Double Double Double Double
|
||||
data Quaternion =
|
||||
Q Double
|
||||
Double
|
||||
Double
|
||||
Double
|
||||
deriving (Show, Ord, Eq)
|
||||
|
||||
realQ :: Quaternion -> Double
|
||||
|
|
@ -11,23 +13,29 @@ realQ (Q r _ _ _) = r
|
|||
imagQ :: Quaternion -> [Double]
|
||||
imagQ (Q _ i j k) = [i, j, k]
|
||||
|
||||
quaternionFromScalar :: Double -> Quaternion
|
||||
quaternionFromScalar s = Q s 0 0 0
|
||||
|
||||
listFromQ (Q a b c d) = [a,b,c,d]
|
||||
listFromQ :: Quaternion -> [Double]
|
||||
listFromQ (Q a b c d) = [a, b, c, d]
|
||||
|
||||
quaternionFromList :: [Double] -> Quaternion
|
||||
quaternionFromList [a, b, c, d] = Q a b c d
|
||||
|
||||
addQ, subQ, mulQ :: Quaternion -> Quaternion -> Quaternion
|
||||
addQ (Q a b c d) (Q p q r s) = Q (a+p) (b+q) (c+r) (d+s)
|
||||
addQ (Q a b c d) (Q p q r s) = Q (a + p) (b + q) (c + r) (d + s)
|
||||
|
||||
subQ (Q a b c d) (Q p q r s) = Q (a-p) (b-q) (c-r) (d-s)
|
||||
subQ (Q a b c d) (Q p q r s) = Q (a - p) (b - q) (c - r) (d - s)
|
||||
|
||||
mulQ (Q a b c d) (Q p q r s) =
|
||||
Q (a*p - b*q - c*r - d*s)
|
||||
(a*q + b*p + c*s - d*r)
|
||||
(a*r - b*s + c*p + d*q)
|
||||
(a*s + b*r - c*q + d*p)
|
||||
Q
|
||||
(a * p - b * q - c * r - d * s)
|
||||
(a * q + b * p + c * s - d * r)
|
||||
(a * r - b * s + c * p + d * q)
|
||||
(a * s + b * r - c * q + d * p)
|
||||
|
||||
normQ = sqrt. sum. join (zipWith (*)). listFromQ
|
||||
normQ :: Quaternion -> Double
|
||||
normQ = sqrt . sum . join (zipWith (*)) . listFromQ
|
||||
|
||||
conjQ, negQ :: Quaternion -> Quaternion
|
||||
conjQ (Q a b c d) = Q a (-b) (-c) (-d)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,43 @@
|
|||
[q,q1,q2] = map quaternionFromList [[1..4],[2..5],[3..6]]
|
||||
-- a*b == b*a
|
||||
test :: Quaternion -> Quaternion -> Bool
|
||||
test a b = a `mulQ` b == b `mulQ` a
|
||||
class Quaternion(a, b, c, d)
|
||||
|
||||
method norm ()
|
||||
return sqrt (a*a + b*b + c*c + d*d)
|
||||
end
|
||||
|
||||
method negative ()
|
||||
return Quaternion(-a, -b, -c, -d)
|
||||
end
|
||||
|
||||
method conjugate ()
|
||||
return Quaternion(a, -b, -c, -d)
|
||||
end
|
||||
|
||||
method add (n)
|
||||
if type(n) == "Quaternion__state"
|
||||
then return Quaternion(a+n.a, b+n.b, c+n.c, d+n.d)
|
||||
else return Quaternion(a+n, b, c, d)
|
||||
end
|
||||
|
||||
method multiply (n)
|
||||
if type(n) == "Quaternion__state"
|
||||
then return Quaternion(a*n.a - b*n.b - c*n.c - d*n.d,
|
||||
a*n.b + b*n.a + c*n.d - d*n.c,
|
||||
a*n.c - b*n.d + c*n.a + d*n.b,
|
||||
a*n.d + b*n.c - c*n.b + d*n.a)
|
||||
else return Quaternion(a*n, b*n, c*n, d*n)
|
||||
end
|
||||
|
||||
method sign (n)
|
||||
return if n >= 0 then "+" else "-"
|
||||
end
|
||||
|
||||
method string ()
|
||||
return ("" || a || sign(b) || abs(b) || "i" || sign(c) || abs(c) || "j" || sign(d) || abs(d) || "k");
|
||||
end
|
||||
|
||||
initially(a, b, c, d)
|
||||
self.a := if /a then 0 else a
|
||||
self.b := if /b then 0 else b
|
||||
self.c := if /c then 0 else c
|
||||
self.d := if /d then 0 else d
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1,43 +1,16 @@
|
|||
class Quaternion(a, b, c, d)
|
||||
procedure main ()
|
||||
q := Quaternion (1,2,3,4)
|
||||
q1 := Quaternion (2,3,4,5)
|
||||
q2 := Quaternion (3,4,5,6)
|
||||
r := 7
|
||||
|
||||
method norm ()
|
||||
return sqrt (a*a + b*b + c*c + d*d)
|
||||
end
|
||||
|
||||
method negative ()
|
||||
return Quaternion(-a, -b, -c, -d)
|
||||
end
|
||||
|
||||
method conjugate ()
|
||||
return Quaternion(a, -b, -c, -d)
|
||||
end
|
||||
|
||||
method add (n)
|
||||
if type(n) == "Quaternion__state"
|
||||
then return Quaternion(a+n.a, b+n.b, c+n.c, d+n.d)
|
||||
else return Quaternion(a+n, b, c, d)
|
||||
end
|
||||
|
||||
method multiply (n)
|
||||
if type(n) == "Quaternion__state"
|
||||
then return Quaternion(a*n.a - b*n.b - c*n.c - d*n.d,
|
||||
a*n.b + b*n.a + c*n.d - d*n.c,
|
||||
a*n.c - b*n.d + c*n.a + d*n.b,
|
||||
a*n.d + b*n.c - c*n.b + d*n.a)
|
||||
else return Quaternion(a*n, b*n, c*n, d*n)
|
||||
end
|
||||
|
||||
method sign (n)
|
||||
return if n >= 0 then "+" else "-"
|
||||
end
|
||||
|
||||
method string ()
|
||||
return ("" || a || sign(b) || abs(b) || "i" || sign(c) || abs(c) || "j" || sign(d) || abs(d) || "k");
|
||||
end
|
||||
|
||||
initially(a, b, c, d)
|
||||
self.a := if /a then 0 else a
|
||||
self.b := if /b then 0 else b
|
||||
self.c := if /c then 0 else c
|
||||
self.d := if /d then 0 else d
|
||||
write ("The norm of " || q.string() || " is " || q.norm ())
|
||||
write ("The negative of " || q.string() || " is " || q.negative().string ())
|
||||
write ("The conjugate of " || q.string() || " is " || q.conjugate().string ())
|
||||
write ("Sum of " || q.string() || " and " || r || " is " || q.add(r).string ())
|
||||
write ("Sum of " || q.string() || " and " || q1.string() || " is " || q.add(q1).string ())
|
||||
write ("Product of " || q.string() || " and " || r || " is " || q.multiply(r).string ())
|
||||
write ("Product of " || q.string() || " and " || q1.string() || " is " || q.multiply(q1).string ())
|
||||
write ("q1*q2 = " || q1.multiply(q2).string ())
|
||||
write ("q2*q1 = " || q2.multiply(q1).string ())
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1,45 +1,43 @@
|
|||
/*REXX pgm performs some operations on quaternion type numbers and shows results*/
|
||||
q = 1 2 3 4 ; q1 = 2 3 4 5
|
||||
r = 7 ; q2 = 3 4 5 6
|
||||
call qShow q , 'q'
|
||||
call qShow q1 , 'q1'
|
||||
call qShow q2 , 'q2'
|
||||
call qShow r , 'r'
|
||||
call qShow qNorm(q) , 'norm q' , "task 1:"
|
||||
call qShow qNeg(q) , 'negative q' , "task 2:"
|
||||
call qShow qConj(q) , 'conjugate q' , "task 3:"
|
||||
call qShow qAdd( r, q ) , 'addition r+q' , "task 4:"
|
||||
call qShow qAdd(q1, q2 ) , 'addition q1+q2' , "task 5:"
|
||||
call qShow qMul( q, r ) , 'multiplication q*r' , "task 6:"
|
||||
call qShow qMul(q1, q2 ) , 'multiplication q1*q2' , "task 7:"
|
||||
call qShow qMul(q2, q1 ) , 'multiplication q2*q1' , "task 8:"
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────*/
|
||||
qConj: procedure; parse arg x; call qXY; return x.1 (-x.2) (-x.3) (-x.4)
|
||||
qNeg: procedure; parse arg x; call qXY; return -x.1 (-x.2) (-x.3) (-x.4)
|
||||
/*──────────────────────────────────────────────────────────────────────────────*/
|
||||
qAdd: procedure; parse arg x,y; call qXY 2; return x.1+y.1 x.2+y.2 x.3+y.3 x.4+y.4
|
||||
/*──────────────────────────────────────────────────────────────────────────────*/
|
||||
/*REXX program performs some operations on quaternion type numbers and displays results*/
|
||||
q = 1 2 3 4 ; q1 = 2 3 4 5
|
||||
r = 7 ; q2 = 3 4 5 6
|
||||
call qShow q , 'q'
|
||||
call qShow q1 , 'q1'
|
||||
call qShow q2 , 'q2'
|
||||
call qShow r , 'r'
|
||||
call qShow qNorm(q) , 'norm q' , "task 1:"
|
||||
call qShow qNeg(q) , 'negative q' , "task 2:"
|
||||
call qShow qConj(q) , 'conjugate q' , "task 3:"
|
||||
call qShow qAdd( r, q ) , 'addition r+q' , "task 4:"
|
||||
call qShow qAdd(q1, q2 ) , 'addition q1+q2' , "task 5:"
|
||||
call qShow qMul( q, r ) , 'multiplication q*r' , "task 6:"
|
||||
call qShow qMul(q1, q2 ) , 'multiplication q1*q2' , "task 7:"
|
||||
call qShow qMul(q2, q1 ) , 'multiplication q2*q1' , "task 8:"
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
qConj: procedure; parse arg x; call qXY; return x.1 (-x.2) (-x.3) (-x.4)
|
||||
qNeg: procedure; parse arg x; call qXY; return -x.1 (-x.2) (-x.3) (-x.4)
|
||||
qNorm: procedure; parse arg x; call qXY; return sqrt(x.1**2 +x.2**2 +x.3**2 +x.4**2)
|
||||
qAdd: procedure; parse arg x,y; call qXY 2; return x.1+y.1 x.2+y.2 x.3+y.3 x.4+y.4
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
qMul: procedure; parse arg x,y; call qXY y
|
||||
return x.1*y.1-x.2*y.2-x.3*y.3-x.4*y.4 x.1*y.2+x.2*y.1+x.3*y.4-x.4*y.3,
|
||||
x.1*y.3-x.2*y.4+x.3*y.1+x.4*y.2 x.1*y.4+x.2*y.3-x.3*y.2+x.4*y.1
|
||||
/*──────────────────────────────────────────────────────────────────────────────*/
|
||||
qNorm: procedure; parse arg x; call qXY; return sqrt(x.1**2+x.2**2+x.3**2+x.4**2)
|
||||
/*──────────────────────────────────────────────────────────────────────────────*/
|
||||
qShow: procedure; parse arg x; call qXY; $=
|
||||
do m=1 for 4; _=x.m; if _==0 then iterate; if _>=0 then _='+'_
|
||||
if m\==1 then _=_ || substr('~ijk',m,1); $=strip($ || _,,'+')
|
||||
return x.1*y.1 -x.2*y.2 -x.3*y.3 -x.4*y.4 x.1*y.2 +x.2*y.1 +x.3*y.4 -x.4*y.3 ,
|
||||
x.1*y.3 -x.2*y.4 +x.3*y.1 +x.4*y.2 x.1*y.4 +x.2*y.3 -x.3*y.2 +x.4*y.1
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
qShow: procedure; parse arg x; call qXY; $=
|
||||
do m=1 for 4; _=x.m; if _==0 then iterate; if _>=0 then _="+"_
|
||||
if m\==1 then _= _ || substr('~ijk', m, 1); $=strip($ || _,,"+")
|
||||
end /*m*/
|
||||
say left(arg(3),9) right(arg(2),20) ' ──► ' $
|
||||
say left(arg(3), 9) right(arg(2), 20) ' ──► ' $
|
||||
return $
|
||||
/*──────────────────────────────────────────────────────────────────────────────*/
|
||||
qXY: do n=1 for 4; x.n=word(word(x,n) 0,1)/1; end /*n*/
|
||||
if arg()==1 then do m=1 for 4; y.m=word(word(y,m) 0,1)/1; end /*m*/
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
qXY: do n=1 for 4; x.n= word( word(x, n) 0, 1) / 1; end /*n*/
|
||||
if arg()==1 then do m=1 for 4; y.m= word( word(y, m) 0, 1) / 1; end /*m*/
|
||||
return
|
||||
/*──────────────────────────────────────────────────────────────────────────────*/
|
||||
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9
|
||||
numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end
|
||||
parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2
|
||||
do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/
|
||||
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/
|
||||
numeric digits d; return (g/1)i /*make complex if X < 0. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
sqrt: procedure; parse arg x; if x=0 then return 0; d= digits(); i=; m.=9; h=d+6
|
||||
numeric digits; numeric form; if x<0 then do; x= -x; i= 'i'; end
|
||||
parse value format(x, 2, 1, , 0) 'E0' with g 'E' _ .; g= g *.5'e'_ % 2
|
||||
do j=0 while h>9; m.j=h; h= h % 2 + 1; end /*j*/
|
||||
do k=j+5 to 0 by -1; numeric digits m.k; g= (g + x/g)* .5; end /*k*/
|
||||
numeric digits d; return (g/1)i /*make complex if X<0. */
|
||||
|
|
|
|||
|
|
@ -1,36 +1,31 @@
|
|||
case class Quaternion(re:Double =0.0, i:Double =0.0, j:Double =0.0, k:Double =0.0) {
|
||||
lazy val im=(i, j, k)
|
||||
private lazy val norm2=re*re + i*i + j*j + k*k
|
||||
lazy val norm=math.sqrt(norm2)
|
||||
case class Quaternion(re: Double = 0.0, i: Double = 0.0, j: Double = 0.0, k: Double = 0.0) {
|
||||
lazy val im = (i, j, k)
|
||||
private lazy val norm2 = re*re + i*i + j*j + k*k
|
||||
lazy val norm = math.sqrt(norm2)
|
||||
|
||||
def negative=new Quaternion(-re, -i, -j, -k)
|
||||
def conjugate=new Quaternion(re, -i, -j, -k)
|
||||
def reciprocal=new Quaternion(re/norm2, -i/norm2, -j/norm2, -k/norm2)
|
||||
def negative = Quaternion(-re, -i, -j, -k)
|
||||
def conjugate = Quaternion(re, -i, -j, -k)
|
||||
def reciprocal = Quaternion(re/norm2, -i/norm2, -j/norm2, -k/norm2)
|
||||
|
||||
def +(q:Quaternion)=new Quaternion(re+q.re, i+q.i, j+q.j, k+q.k)
|
||||
def -(q:Quaternion)=new Quaternion(re-q.re, i-q.i, j-q.j, k-q.k)
|
||||
def *(q:Quaternion)=new Quaternion(
|
||||
def +(q: Quaternion) = Quaternion(re+q.re, i+q.i, j+q.j, k+q.k)
|
||||
def -(q: Quaternion) = Quaternion(re-q.re, i-q.i, j-q.j, k-q.k)
|
||||
def *(q: Quaternion) = Quaternion(
|
||||
re*q.re - i*q.i - j*q.j - k*q.k,
|
||||
re*q.i + i*q.re + j*q.k - k*q.j,
|
||||
re*q.j - i*q.k + j*q.re + k*q.i,
|
||||
re*q.k + i*q.j - j*q.i + k*q.re
|
||||
)
|
||||
def /(q:Quaternion)=this*q.reciprocal
|
||||
def /(q: Quaternion) = this * q.reciprocal
|
||||
|
||||
def unary_- = negative
|
||||
def unary_~ = conjugate
|
||||
|
||||
override def equals(x:Any):Boolean=x match {
|
||||
case Quaternion(re, i, j, k) => (Double.doubleToLongBits(this.re)==Double.doubleToLongBits(re)) &&
|
||||
Double.doubleToLongBits(this.i)==Double.doubleToLongBits(i) &&
|
||||
Double.doubleToLongBits(this.j)==Double.doubleToLongBits(j) &&
|
||||
Double.doubleToLongBits(this.k)==Double.doubleToLongBits(k)
|
||||
case _ => false
|
||||
}
|
||||
|
||||
override def toString()="Q(%.2f, %.2fi, %.2fj, %.2fk)".formatLocal(Locale.ENGLISH, re,i,j,k)
|
||||
override def toString = "Q(%.2f, %.2fi, %.2fj, %.2fk)".formatLocal(java.util.Locale.ENGLISH, re, i, j, k)
|
||||
}
|
||||
|
||||
object Quaternion {
|
||||
implicit def number2Quaternion[T <% Number](n:T):Quaternion = apply(n.doubleValue)
|
||||
import scala.language.implicitConversions
|
||||
import Numeric.Implicits._
|
||||
|
||||
implicit def number2Quaternion[T:Numeric](n: T) = Quaternion(n.toDouble)
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue