aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

September Morn Update

Browse source
This commit is contained in:
Ingy döt Net 2019-09-12 10:33:56 -07:00
parent 4e2d22a71d
commit aac6731f2c
6856 changed files with 141342 additions and 21127 deletions
Download patch file Download diff file Expand all files Collapse all files

56
Task/Quaternion-type/Haskell/quaternion-type-1.hs
View file

@ -1,43 +1,53 @@
import Control.Monad (join)
data Quaternion =
Q Double
Double
Double
Double
deriving (Show, Ord, Eq)
data Quaternion a =
Q a a a a
deriving (Show, Eq)
realQ :: Quaternion -> Double
realQ :: Quaternion a -> a
realQ (Q r _ _ _) = r
imagQ :: Quaternion -> [Double]
imagQ :: Quaternion a -> [a]
imagQ (Q _ i j k) = [i, j, k]
quaternionFromScalar :: Double -> Quaternion
quaternionFromScalar :: (Num a) => a -> Quaternion a
quaternionFromScalar s = Q s 0 0 0
listFromQ :: Quaternion -> [Double]
listFromQ :: Quaternion a -> [a]
listFromQ (Q a b c d) = [a, b, c, d]
quaternionFromList :: [Double] -> Quaternion
quaternionFromList :: [a] -> Quaternion a
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)
normQ :: (RealFloat a) => Quaternion a -> a
normQ = sqrt . sum . join (zipWith (*)) . listFromQ
subQ (Q a b c d) (Q p q r s) = Q (a - p) (b - q) (c - r) (d - s)
conjQ :: (Num a) => Quaternion a -> Quaternion a
conjQ (Q a b c d) = Q a (-b) (-c) (-d)
mulQ (Q a b c d) (Q p q r s) =
Q
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)
normQ :: Quaternion -> Double
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)
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]"