Quaternion type: Difference between revisions
Content deleted Content added
→{{header|Forth}}: bug |
+Haskell |
||
Line 487: | Line 487: | ||
m2 q2 q1 q* m2 q. \ ( -56. 18. 20. 28. ) |
m2 q2 q1 q* m2 q. \ ( -56. 18. 20. 28. ) |
||
m1 m2 q= . \ 0 (false)</lang> |
m1 m2 q= . \ 0 (false)</lang> |
||
=={{header|Haskell}}== |
|||
<lang haskell>import Control.Monad |
|||
import Control.Arrow |
|||
import Data.List |
|||
data Quaternion = Q Double Double Double Double |
|||
deriving (Show, Ord, Eq) |
|||
realQ :: Quaternion -> Double |
|||
realQ (Q r _ _ _) = r |
|||
imagQ :: Quaternion -> [Double] |
|||
imagQ (Q _ i j k) = [i, j, k] |
|||
quaternionFromScalar s = Q s 0 0 0 |
|||
listFromQ (Q a b c d) = [a,b,c,d] |
|||
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) |
|||
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) |
|||
normQ = sqrt. sum. join (zipWith (*)). listFromQ |
|||
conjQ, negQ :: Quaternion -> Quaternion |
|||
conjQ (Q a b c d) = Q a (-b) (-c) (-d) |
|||
negQ (Q a b c d) = Q (-a) (-b) (-c) (-d)</lang> |
|||
To use with the Examples: |
|||
<lang haskell>[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</lang> |
|||
Examples: |
|||
<pre>*Main> mulQ (Q 0 1 0 0) $ mulQ (Q 0 0 1 0) (Q 0 0 0 1) -- i*j*k |
|||
Q (-1.0) 0.0 0.0 0.0 |
|||
*Main> test q1 q2 |
|||
False |
|||
*Main> mulQ q1 q2 |
|||
Q (-56.0) 16.0 24.0 26.0 |
|||
*Main> flip mulQ q1 q2 |
|||
Q (-56.0) 18.0 20.0 28.0 |
|||
*Main> imagQ q |
|||
[2.0,3.0,4.0]</pre> |
|||
=={{header|J}}== |
=={{header|J}}== |