Initial data commit

Task/Quaternion-type/Haskell/quaternion-type-1.hs

@@ -0,0 +1,53 @@
+import Control.Monad (join)
+
+data Quaternion a =
+  Q a a a a
+  deriving (Show, Eq)
+
+realQ :: Quaternion a -> a
+realQ (Q r _ _ _) = r
+
+imagQ :: Quaternion a -> [a]
+imagQ (Q _ i j k) = [i, j, k]
+
+quaternionFromScalar :: (Num a) => a -> Quaternion a
+quaternionFromScalar s = Q s 0 0 0
+
+listFromQ :: Quaternion a -> [a]
+listFromQ (Q a b c d) = [a, b, c, d]
+
+quaternionFromList :: [a] -> Quaternion a
+quaternionFromList [a, b, c, d] = Q a b c d
+
+normQ :: (RealFloat a) => Quaternion a -> a
+normQ = sqrt . sum . join (zipWith (*)) . listFromQ
+
+conjQ :: (Num a) => Quaternion a -> Quaternion a
+conjQ (Q a b c d) = Q a (-b) (-c) (-d)
+
+instance (RealFloat a) => Num (Quaternion a) where
+  (Q a b c d) + (Q p q r s) = Q (a + p) (b + q) (c + r) (d + s)
+  (Q a b c d) - (Q p q r s) = Q (a - p) (b - q) (c - r) (d - s)
+  (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)
+  negate (Q a b c d)        = Q (-a) (-b) (-c) (-d)
+  abs q                     = quaternionFromScalar (normQ q)
+  signum (Q 0 0 0 0)        = 0
+  signum q@(Q a b c d)      = Q (a/n) (b/n) (c/n) (d/n) where n = normQ q
+  fromInteger n             = quaternionFromScalar (fromInteger n)
+
+main :: IO ()
+main = do
+  let q, q1, q2 :: Quaternion Double
+      q  = Q 1 2 3 4
+      q1 = Q 2 3 4 5
+      q2 = Q 3 4 5 6
+  print $ (Q 0 1 0 0) * (Q 0 0 1 0) * (Q 0 0 0 1) -- i*j*k; prints "Q (-1.0) 0.0 0.0 0.0"
+  print $ q1 * q2                                 -- prints "Q (-56.0) 16.0 24.0 26.0"
+  print $ q2 * q1                                 -- prints "Q (-56.0) 18.0 20.0 28.0"
+  print $ q1 * q2 == q2 * q1                      -- prints "False"
+  print $ imagQ q                                 -- prints "[2.0,3.0,4.0]"

Task/Quaternion-type/Haskell/quaternion-type-2.hs

@@ -0,0 +1,43 @@
+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

Task/Quaternion-type/Haskell/quaternion-type-3.hs

@@ -0,0 +1,16 @@
+procedure main ()
+  q := Quaternion (1,2,3,4)
+  q1 := Quaternion (2,3,4,5)
+  q2 := Quaternion (3,4,5,6)
+  r := 7
+
+  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