cayley-dickson 0.2.0.0 → 0.2.1.0

raw patch · 3 files changed

+111/−59 lines, 3 filesdep ~basedep ~randomPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, random

API changes (from Hackage documentation)

Files

• cayley-dickson.cabal +3/−3
• src/Math/CayleyDickson.hs +38/−25
• test/test.hs +70/−31

@@ -1,5 +1,5 @@ name:                cayley-dickson-version:             0.2.0.0+version:             0.2.1.0 synopsis:            Complex numbers, quaternions, octonions, sedenions, etc. description:         Cayley-Dickson constructions (complex numbers, quaternions,                      octonions, sedenions, etc.) over general scalars without@@ -23,7 +23,7 @@ library   exposed-modules:   Math.CayleyDickson   hs-source-dirs:    src-  build-depends:     base >= 4.8 && < 5+  build-depends:     base >= 4.7 && < 5   default-language:  Haskell2010   ghc-options:       -Wall -O2 @@ -31,6 +31,6 @@   type:              exitcode-stdio-1.0   hs-source-dirs:    test, src   main-is:           test.hs-  build-depends:     base >= 4.8 && < 5, random >= 1+  build-depends:     base >= 4.7 && < 5, random == 1.*   default-language:  Haskell2010   ghc-options:       -Wall

@@ -66,7 +66,7 @@     basisElement,      -- * Classes-    Conjugable(conj),+    Conjugable(..),      -- ** Tags     Tag(tagVal),@@ -129,16 +129,19 @@ purePart (Scalar _) = Scalar 0 purePart (x :@ y) = purePart x :@ y --- | Dot product (actually the Hermitian inner product, a--- generalization of the dot product).+-- | Dot product. @(1 \`dot\`)@ is equivalent to @'scalarPart'@. dot :: Conjugable a => Nion n a -> Nion n a -> a-Scalar x `dot` Scalar y = conj x * y -- also defined as x * conj y+-- (y * conj x + x * conj y) / 2+Scalar x `dot` Scalar y = scalarPart' $ y * conj x x@(Scalar _) `dot` (y1 :@ _) = x `dot` y1 (x1 :@ _) `dot` y@(Scalar _) = x1 `dot` y (x1 :@ x2) `dot` (y1 :@ y2) = (x1 `dot` y1) + (x2 `dot` y2) --- | Cross product.+-- | Cross product. @(1 \`cross\`)@ is equivalent to @'purePart'@. The+-- cross product of two pures yields an element that is orthogonal to+-- both operands. cross :: Conjugable a => Nion n a -> Nion n a -> Nion n a+-- (y * conj x - x * conj y) / 2 x `cross` y = y * conj x -. x `dot` y  -- | Squared norm: the dot product of an element with itself.@@ -343,9 +346,10 @@  coord' :: (Tag n, Num a, Integral b, Bits b) => Proxy n -> Nion n a -> b -> a coord' _ (Scalar x) 0 = x-coord' _ (Scalar _) _ = 0 coord' n elt index-  | validIndex n index = f elt $ fromInteger $ tagVal n - 1+  | validIndex n index = case elt of+                           Scalar _ -> 0+                           _ -> f elt $ fromInteger $ tagVal n - 1   | otherwise = error "coord: out of range"   where     f (Scalar x) _ = x@@ -430,9 +434,8 @@  instance (Conjugable a, Fractional a) => Fractional (Nion n a) where   Scalar x / Scalar y = Scalar $ x / y-  x@(Scalar _) / y@(_ :@ _) = x * recip y   x@(_ :@ _) / Scalar y = smap (/ y) x-  x@(_ :@ _) / y@(_ :@ _) = (x * conj y) /. sqnorm y+  x / y = (x * conj y) /. sqnorm y    recip x = conj x /. sqnorm x   fromRational = fromScalar . fromRational@@ -512,31 +515,41 @@  -- | The /conjugate/ of an element is obtained by negating the pure -- part and conjugating the scalar part. The conjugate of a real--- number (which has no pure part) is the identity ('id').+-- number is the identity ('id'), which is the default implementation. class Num a => Conjugable a where+  -- | Conjugate.   conj :: a -> a+  conj = id +  -- | Equivalent to @(x + conj x) / 2@.+  scalarPart' :: a -> a+  scalarPart' = id+ instance Conjugable a => Conjugable (Nion n a) where   conj (Scalar x) = Scalar $ conj x   conj (x :@ y) = conj x :@ negate y -instance RealFloat a => Conjugable (C.Complex a) where+  scalarPart' (Scalar x) = Scalar $ scalarPart' x+  scalarPart' (x :@ _) = scalarPart' x++instance (Conjugable a, RealFloat a) => Conjugable (C.Complex a) where   conj = C.conjugate+  scalarPart' (x C.:+ _) = scalarPart' x C.:+ 0 -instance Conjugable Int where conj = id-instance Conjugable Integer where conj = id-instance Conjugable Float where conj = id-instance Conjugable Double where conj = id-instance Conjugable Z.Int8 where conj = id-instance Conjugable Z.Int16 where conj = id-instance Conjugable Z.Int32 where conj = id-instance Conjugable Z.Int64 where conj = id-instance Conjugable W.Word8 where conj = id-instance Conjugable W.Word16 where conj = id-instance Conjugable W.Word32 where conj = id-instance Conjugable W.Word64 where conj = id-instance Integral a => Conjugable (Q.Ratio a) where conj = id-instance F.HasResolution a => Conjugable (F.Fixed a) where conj = id+instance Conjugable Int+instance Conjugable Integer+instance Conjugable Float+instance Conjugable Double+instance Conjugable Z.Int8+instance Conjugable Z.Int16+instance Conjugable Z.Int32+instance Conjugable Z.Int64+instance Conjugable W.Word8+instance Conjugable W.Word16+instance Conjugable W.Word32+instance Conjugable W.Word64+instance Integral a => Conjugable (Q.Ratio a)+instance F.HasResolution a => Conjugable (F.Fixed a)  ----------------------------------------------------------------------------- -- doNotUse

@@ -3,11 +3,12 @@ import Data.Ratio (Ratio, (%)) import Control.Monad (replicateM, replicateM_, forM_, liftM) import System.Random (Random, randomRIO)+import System.IO (hFlush, stdout)  ---------------------------------------------------------- -- alternate formulas -pureDir :: (Tag n, Conjugable a, Floating a) => Nion n a -> Nion n a+pureDir :: (Conjugable a, Floating a) => Nion n a -> Nion n a pureDir x = p /. (norm p) where p = purePart x  cos' :: (Tag n, Conjugable a, RealFloat a) => Nion n a -> Nion n a@@ -22,11 +23,10 @@ sinh' :: (Tag n, Conjugable a, RealFloat a) => Nion n a -> Nion n a sinh' x = (exp x - exp (- x)) / 2 -dot' :: (Tag n, Conjugable a, Fractional a) => Nion n a -> Nion n a -> a+dot' :: (Conjugable a, Fractional a) => Nion n a -> Nion n a -> a dot' x y = scalarPart $ (y * conj x + x * conj y) / 2 -cross' :: (Tag n, Conjugable a, Fractional a) =>-          Nion n a -> Nion n a -> Nion n a+cross' :: (Conjugable a, Fractional a) => Nion n a -> Nion n a -> Nion n a cross' x y = (y * conj x - x * conj y) / 2  qmul :: Num a => a -> a -> a -> a ->@@ -43,16 +43,18 @@ epsilon = 1e-7  assert :: Bool -> IO ()-assert True = putChar '.'+assert True = do+  putChar '.'+  hFlush stdout assert False = error "assertion failed" -close :: Tag n => Nion n Double -> Nion n Double -> Bool+close :: Nion n Double -> Nion n Double -> Bool close x y = norm (x - y) < epsilon  closeReal :: Double -> Double -> Bool closeReal x y = abs (x - y) < epsilon -assertClose :: Tag n => Nion n Double -> Nion n Double -> IO ()+assertClose :: Nion n Double -> Nion n Double -> IO () assertClose x y = assert $ close x y  assertCloseReal :: Double -> Double -> IO ()@@ -79,13 +81,7 @@ randomEltI = randomElt boundsI  randomEltI' :: (Tag n1, Tag n2) => Integer -> IO (Nion n1 (Nion n2 Integer))-randomEltI' n = liftM nion $ replicateM (fromIntegral n) randomEltI--randomEltI2 :: Tag n => IO (Complex (Nion n Integer))-randomEltI2 = randomEltI' 2--randomEltI4 :: Tag n => IO (Quaternion (Nion n Integer))-randomEltI4 = randomEltI' 4+randomEltI' n = liftM nion $ replicateM (2^n) $ randomEltI  ---------------------------------------------------------- -- checks@@ -117,17 +113,16 @@ checkFloating1 :: Tag n => Nion n Double -> IO () checkFloating1 = checkFloating1' Proxy -checkFloating2' :: Tag n => Proxy n -> Nion n Double -> Nion n Double -> IO ()-checkFloating2' _ x y = do+checkFloating2 :: Nion n Double -> Nion n Double -> IO ()+checkFloating2 x y = do   assertCloseReal (x `dot` y) (x `dot'` y)   assertCloseReal (5 `dot` y) (5 `dot'` y)   assertCloseReal (x `dot` 5) (x `dot'` 5)+  assertCloseReal (3 `dot` 5) (3 `dot'` 5)   assertClose (x `cross` y) (x `cross'` y)   assertClose (5 `cross` y) (5 `cross'` y)   assertClose (x `cross` 5) (x `cross'` 5)--checkFloating2 :: Tag n => Nion n Double -> Nion n Double -> IO ()-checkFloating2 = checkFloating2' Proxy+  assertClose (3 `cross` 5) (3 `cross'` 5)  checkFloating3 :: Tag n => Nion n Double -> IO () checkFloating3 x' = do@@ -295,6 +290,7 @@   let y = quaternion 1 2 3 4 :: Quaternion (Ratio Integer)   assert $ y / 2 == quaternion (1 % 2) 1 (3 % 2) 2   assert $ recip y == quaternion (1 % 30) (-1 % 15) (-1 % 10) (-2 % 15)+  assert $ 3 / y == quaternion (1 % 10) (-1 % 5) (-3 % 10) (-2 % 5)   assert $ y * recip y == 1  checkPower :: IO ()@@ -315,12 +311,12 @@   assert $ y ^^. (-1 :: Integer) == recip y   assert $ y ^^. (-2 :: Integer) == recip (y * y) -checkZeroAndOne :: (Show a, Eq a, Conjugable a) => Nion n1 (Nion n2 a) -> IO ()+checkZeroAndOne :: (Conjugable a, Eq a) => Nion n1 (Nion n2 a) -> IO () checkZeroAndOne x = do   assert $ 0 + x == x   assert $ 1 * x == x -checkDistributive :: (Show a, Eq a, Conjugable a) =>+checkDistributive :: (Conjugable a, Eq a) =>                      Nion n1 (Nion n2 a) -> Nion n1 (Nion n2 a) ->                      Nion n2 a -> Nion n2 a ->                      IO ()@@ -328,7 +324,7 @@   assert $ (r + s) .* x == r .* x + s .* x   assert $ r .* (x + y) == r .* x + r .* y -checkModule :: (Show a, Eq a, Conjugable a) =>+checkModule :: (Conjugable a, Eq a) =>                Nion n1 (Nion n2 a) -> Nion n1 (Nion n2 a) ->                Nion n2 a -> Nion n2 a -> IO () checkModule x y r s = do@@ -336,7 +332,18 @@   checkZeroAndOne x   assert $ (r * s) .* x == r .* (s .* x) -checkIsomorphism :: (Conjugable a, Show a, Eq a) =>+checkDotCross :: (Conjugable a, Eq a) =>+                 Nion n1 (Nion n2 a) -> Nion n1 (Nion n2 a) -> IO ()+checkDotCross x' y' = do+  let x = purePart x'+      y = purePart y'+      x_cross_y = x `cross` y+  assert $ 2 * fromScalar (x `dot` y) == y * conj x + x * conj y+  assert $ 2 * x_cross_y == y * conj x - x * conj y+  assert $ x `dot` x_cross_y == 0+  assert $ y `dot` x_cross_y == 0++checkIsomorphism :: (Conjugable a, Eq a) =>                     ((Nion n1 (Nion n2 a)) -> Nion n3 a) ->                     (Nion n1 (Nion n2 a)) -> (Nion n1 (Nion n2 a)) ->                     IO ()@@ -349,6 +356,8 @@   assert $ f (x - y) == f x - f y   assert $ f (x * y) == f x * f y   assert $ scalarPart (sqnorm x) == sqnorm (f x)+  assert $ scalarPart (x `dot` y) == f x `dot` f y+  assert $ f (x `cross` y) == f x `cross` f y  phi :: (Tag n1, Tag n2, Tag n3, Conjugable a) =>        (Nion n1 (Nion n2 a)) -> Nion n3 a@@ -359,42 +368,70 @@   let f = phi :: Complex (Complex Integer) -> Quaternion Integer   r <- randomEltI :: IO (Complex Integer)   s <- randomEltI :: IO (Complex Integer)-  x <- randomEltI2 :: IO (Complex (Complex Integer))-  y <- randomEltI2 :: IO (Complex (Complex Integer))+  x <- randomEltI' 1 :: IO (Complex (Complex Integer))+  y <- randomEltI' 1 :: IO (Complex (Complex Integer))   checkIsomorphism f x y   checkModule x y r s+  checkDotCross x y  checkProperties2 :: IO () checkProperties2 = do   let f = phi :: Complex (Quaternion Integer) -> Octonion Integer   r <- randomEltI :: IO (Quaternion Integer)   s <- randomEltI :: IO (Quaternion Integer)-  x <- randomEltI2 :: IO (Complex (Quaternion Integer))-  y <- randomEltI2 :: IO (Complex (Quaternion Integer))+  x <- randomEltI' 1 :: IO (Complex (Quaternion Integer))+  y <- randomEltI' 1 :: IO (Complex (Quaternion Integer))   checkIsomorphism f x y   checkModule x y r s+  checkDotCross x y  checkProperties3 :: IO () checkProperties3 = do   let f = phi :: Complex (Octonion Integer) -> Sedenion Integer   r <- randomEltI :: IO (Octonion Integer)   s <- randomEltI :: IO (Octonion Integer)-  x <- randomEltI2 :: IO (Complex (Octonion Integer))-  y <- randomEltI2 :: IO (Complex (Octonion Integer))+  x <- randomEltI' 1 :: IO (Complex (Octonion Integer))+  y <- randomEltI' 1 :: IO (Complex (Octonion Integer))   checkIsomorphism f x y   checkDistributive x y r s   checkZeroAndOne x+  checkDotCross x y  checkProperties4 :: IO () checkProperties4 = do   let f = phi :: Quaternion (Complex Integer) -> Octonion Integer   r <- randomEltI :: IO (Complex Integer)   s <- randomEltI :: IO (Complex Integer)-  x <- randomEltI4 :: IO (Quaternion (Complex Integer))-  y <- randomEltI4 :: IO (Quaternion (Complex Integer))+  x <- randomEltI' 2 :: IO (Quaternion (Complex Integer))+  y <- randomEltI' 2 :: IO (Quaternion (Complex Integer))   checkIsomorphism f x y   checkModule x y r s+  checkDotCross x y +checkProperties5 :: IO ()+checkProperties5 = do+  let f = phi :: Octonion (Sedenion Integer) -> Nion Tag7 Integer+  r <- randomEltI :: IO (Sedenion Integer)+  s <- randomEltI :: IO (Sedenion Integer)+  x <- randomEltI' 3 :: IO (Octonion (Sedenion Integer))+  y <- randomEltI' 3 :: IO (Octonion (Sedenion Integer))+  checkIsomorphism f x y+  checkZeroAndOne x+  checkDistributive x y r s+  checkDotCross x y++checkProperties6 :: IO ()+checkProperties6 = do+  let f = phi :: Sedenion (Nion Tag5 Integer) -> Nion Tag9 Integer+  r <- randomEltI :: IO (Nion Tag5 Integer)+  s <- randomEltI :: IO (Nion Tag5 Integer)+  x <- randomEltI' 4 :: IO (Sedenion (Nion Tag5 Integer))+  y <- randomEltI' 4 :: IO (Sedenion (Nion Tag5 Integer))+  checkIsomorphism f x y+  checkZeroAndOne x+  checkDistributive x y r s+  checkDotCross x y+ main :: IO () main = do   checkBasic@@ -413,4 +450,6 @@     checkProperties2     checkProperties3     checkProperties4+  checkProperties5+  checkProperties6   putStrLn "\nAll tests passed."