cayley-dickson 0.2.1.0 → 0.3.0.0

raw patch · 3 files changed

+58/−81 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• cayley-dickson.cabal +1/−1
• src/Math/CayleyDickson.hs +28/−54
• test/test.hs +29/−26

@@ -1,5 +1,5 @@ name:                cayley-dickson-version:             0.2.1.0+version:             0.3.0.0 synopsis:            Complex numbers, quaternions, octonions, sedenions, etc. description:         Cayley-Dickson constructions (complex numbers, quaternions,                      octonions, sedenions, etc.) over general scalars without

@@ -56,7 +56,7 @@     --     -- | The mnemonic is that the period (".") is on the side of the     -- scalar.-    (^.), (^^.), (**.),+    (**.),     (.+), (+.), (.-), (-.), (.*), (*.), (/.),      -- * Accessors@@ -103,8 +103,6 @@ infix 7 *. infix 7 /. -infixr 8 ^.-infixr 8 ^^. infixr 8 **.  ----------------------------------------------------------@@ -159,37 +157,6 @@ fromScalar = Scalar  ------------------------------------------------------------- power operations---- | Raise to a non-negative integral power.-(^.) :: (Conjugable a, Integral b) => Nion n a -> b -> Nion n a-Scalar x ^. y = Scalar $ x ^ y--- Copied from GHC's (^) with modifications. (c) The University of--- Glasgow, 1994-2002.-x0 ^. y0 | y0 < 0    = error "(^.): negative exponent"-         | y0 == 0   = Scalar 1-         | otherwise = f x0 y0-         where -- f : x0 ^ y0 = x ^ y-           f x y | even y    = f (x * x) (y `quot` 2)-                 | y == 1    = x-                 | otherwise = g (x * x) ((y - 1) `quot` 2) x-           -- g : x0 ^ y0 = (x ^ y) * z-           g x y z | even y = g (x * x) (y `quot` 2) z-                   | y == 1 = x * z-                   | otherwise = g (x * x) ((y - 1) `quot` 2) (x * z)---- | Raise to an integral power.-(^^.) :: (Conjugable a, Fractional a, Integral b) => Nion n a -> b -> Nion n a-Scalar x ^^. n = Scalar $ x ^^ n-x ^^. n | n >= 0 = x ^. n-        | otherwise = recip $ x ^. negate n---- | Raise to a scalar power.-(**.) :: (Tag n, Conjugable a, RealFloat a) => Nion n a -> a -> Nion n a-Scalar x **. y = Scalar $ x ** y-x **. y = exp (Scalar y * log x)------------------------------------------------------------ -- operations with scalars  leftScalarOp :: (Nion n a -> Nion n a -> Nion n a) -> a -> Nion n a -> Nion n a@@ -226,6 +193,11 @@ (/.) :: (Conjugable a, Fractional a) => Nion n a -> a -> Nion n a (/.) = rightScalarOp (/) +-- | Raise to a scalar power.+(**.) :: (Tag n, Conjugable a, RealFloat a) => Nion n a -> a -> Nion n a+Scalar x **. y = Scalar $ x ** y+x **. y = exp (y .* log x)+ ---------------------------------------------------------- -- polar form and complex function application @@ -241,10 +213,11 @@   | sqnormp == 0 = realPolar sqrtMinus1 r   | otherwise = (normx, acos (r / normx), u)   where+    p = purePart x+    sqnormp = sqnorm p+    u = p /. sqrt sqnormp     r = scalarPart x-    sqnormp = sqnorm x - r*r-    u = purePart x /. sqrt sqnormp-    normx = norm x+    normx = sqrt $ sqnormp + r * conj r  polar' :: (Tag n, Conjugable a, RealFloat a) =>           Proxy n -> Nion n a -> (a, a, Nion n a)@@ -272,12 +245,10 @@   | otherwise = x .+ u *. y   where (s, t, u) = polarUsing sqrtMinus1 z         -- handle special cases for a little more accuracy-        x C.:+ y | t == 0 = f s'-                 | t == pi = f $ (-s) C.:+ 0 -- avoid -0.0-                 | otherwise = f $ s' * exp (t' * u')-                 where s' = s C.:+ 0-                       t' = t C.:+ 0-                       u' = 0 C.:+ 1+        x C.:+ y | t == 0 = f $ c s 0+                 | t == pi = f $ c (-s) 0+                 | otherwise = f $ c s 0 * exp (c t 0 * c 0 1)+                 where c = (C.:+)  applyUsing :: (Tag n, Conjugable a, RealFloat a) =>               Nion n a -> (a -> a) -> (C.Complex a -> C.Complex a) ->@@ -362,19 +333,23 @@ coord :: (Tag n, Num a, Integral b, Bits b) => Nion n a -> b -> a coord = coord' Proxy -setCoord' :: (Tag n, Conjugable a, Num b, Bits b) =>+setCoord' :: (Tag n, Conjugable a, Integral b, Bits b) =>              Proxy n -> Nion n a -> b -> a -> Nion n a setCoord' _ (Scalar _) 0 value = Scalar value-setCoord' _ (Scalar x) index value = setCoord (x .+ paddedZero) index value-setCoord' n elt index value = f elt $ fromInteger $ tagVal n - 1 where-  f (Scalar _) _ = Scalar value-  f (x :@ y) k = case testBit index k of-                   False -> f x k' :@ y-                   True  -> x :@ f y k'-                 where k' = k - 1+setCoord' n elt index value+  | validIndex n index = case elt of+                           Scalar x -> setCoord (x .+ paddedZero) index value+                           _ -> f elt $ fromInteger $ tagVal n - 1+  | otherwise = error "setCoord: out of range"+  where+    f (Scalar _) _ = Scalar value+    f (x :@ y) k = case testBit index k of+                     False -> f x k' :@ y+                     True  -> x :@ f y k'+                   where k' = k - 1  -- | Set the nth coordinate, returning a new element.-setCoord :: (Tag n, Conjugable a, Num b, Bits b) =>+setCoord :: (Tag n, Conjugable a, Integral b, Bits b) =>             Nion n a -> b -> a -> Nion n a setCoord = setCoord' Proxy @@ -441,8 +416,7 @@   fromRational = fromScalar . fromRational  -- | The first pure basis element is arbitrarily chosen as sqrt (-1).-instance (Tag n, Conjugable a, RealFloat a) =>-         Floating (Nion n a) where+instance (Tag n, Conjugable a, RealFloat a) => Floating (Nion n a) where   pi    = Scalar pi   exp   = applyUsing basisElement1 exp exp   log   = applyUsing basisElement1 log log

@@ -80,9 +80,12 @@ randomEltI :: Tag n => IO (Nion n Integer) randomEltI = randomElt boundsI -randomEltI' :: (Tag n1, Tag n2) => Integer -> IO (Nion n1 (Nion n2 Integer))-randomEltI' n = liftM nion $ replicateM (2^n) $ randomEltI+randomEltI'' :: (Tag n1, Tag n2) => Proxy n1 -> IO (Nion n1 (Nion n2 Integer))+randomEltI'' n = liftM nion $ replicateM (2 ^ tagVal n) $ randomEltI +randomEltI' :: (Tag n1, Tag n2) => IO (Nion n1 (Nion n2 Integer))+randomEltI' = randomEltI'' Proxy+ ---------------------------------------------------------- -- checks @@ -296,20 +299,20 @@ checkPower :: IO () checkPower = do   let x = quaternion 1 2 3 4 :: Quaternion Integer-  assert $ x ^. (0 :: Integer) == 1-  assert $ x ^. (1 :: Integer) == x-  assert $ x ^. (2 :: Integer) == x * x-  assert $ x ^. (3 :: Integer) == x * x * x-  assert $ x ^. (4 :: Integer) == x * x * x * x+  assert $ x ^ (0 :: Integer) == 1+  assert $ x ^ (1 :: Integer) == x+  assert $ x ^ (2 :: Integer) == x * x+  assert $ x ^ (3 :: Integer) == x * x * x+  assert $ x ^ (4 :: Integer) == x * x * x * x    let y = quaternion 1 2 3 4 :: Quaternion (Ratio Integer)-  assert $ y ^^. (0 :: Integer) == 1-  assert $ y ^^. (1 :: Integer) == y-  assert $ y ^^. (2 :: Integer) == y * y-  assert $ y ^^. (3 :: Integer) == y * y * y-  assert $ y ^^. (4 :: Integer) == y * y * y * y-  assert $ y ^^. (-1 :: Integer) == recip y-  assert $ y ^^. (-2 :: Integer) == recip (y * y)+  assert $ y ^^ (0 :: Integer) == 1+  assert $ y ^^ (1 :: Integer) == y+  assert $ y ^^ (2 :: Integer) == y * y+  assert $ y ^^ (3 :: Integer) == y * y * y+  assert $ y ^^ (4 :: Integer) == y * y * y * y+  assert $ y ^^ (-1 :: Integer) == recip y+  assert $ y ^^ (-2 :: Integer) == recip (y * y)  checkZeroAndOne :: (Conjugable a, Eq a) => Nion n1 (Nion n2 a) -> IO () checkZeroAndOne x = do@@ -368,8 +371,8 @@   let f = phi :: Complex (Complex Integer) -> Quaternion Integer   r <- randomEltI :: IO (Complex Integer)   s <- randomEltI :: IO (Complex Integer)-  x <- randomEltI' 1 :: IO (Complex (Complex Integer))-  y <- randomEltI' 1 :: IO (Complex (Complex Integer))+  x <- randomEltI' :: IO (Complex (Complex Integer))+  y <- randomEltI' :: IO (Complex (Complex Integer))   checkIsomorphism f x y   checkModule x y r s   checkDotCross x y@@ -379,8 +382,8 @@   let f = phi :: Complex (Quaternion Integer) -> Octonion Integer   r <- randomEltI :: IO (Quaternion Integer)   s <- randomEltI :: IO (Quaternion Integer)-  x <- randomEltI' 1 :: IO (Complex (Quaternion Integer))-  y <- randomEltI' 1 :: IO (Complex (Quaternion Integer))+  x <- randomEltI' :: IO (Complex (Quaternion Integer))+  y <- randomEltI' :: IO (Complex (Quaternion Integer))   checkIsomorphism f x y   checkModule x y r s   checkDotCross x y@@ -390,8 +393,8 @@   let f = phi :: Complex (Octonion Integer) -> Sedenion Integer   r <- randomEltI :: IO (Octonion Integer)   s <- randomEltI :: IO (Octonion Integer)-  x <- randomEltI' 1 :: IO (Complex (Octonion Integer))-  y <- randomEltI' 1 :: IO (Complex (Octonion Integer))+  x <- randomEltI' :: IO (Complex (Octonion Integer))+  y <- randomEltI' :: IO (Complex (Octonion Integer))   checkIsomorphism f x y   checkDistributive x y r s   checkZeroAndOne x@@ -402,8 +405,8 @@   let f = phi :: Quaternion (Complex Integer) -> Octonion Integer   r <- randomEltI :: IO (Complex Integer)   s <- randomEltI :: IO (Complex Integer)-  x <- randomEltI' 2 :: IO (Quaternion (Complex Integer))-  y <- randomEltI' 2 :: IO (Quaternion (Complex Integer))+  x <- randomEltI' :: IO (Quaternion (Complex Integer))+  y <- randomEltI' :: IO (Quaternion (Complex Integer))   checkIsomorphism f x y   checkModule x y r s   checkDotCross x y@@ -413,8 +416,8 @@   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))+  x <- randomEltI' :: IO (Octonion (Sedenion Integer))+  y <- randomEltI' :: IO (Octonion (Sedenion Integer))   checkIsomorphism f x y   checkZeroAndOne x   checkDistributive x y r s@@ -425,8 +428,8 @@   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))+  x <- randomEltI' :: IO (Sedenion (Nion Tag5 Integer))+  y <- randomEltI' :: IO (Sedenion (Nion Tag5 Integer))   checkIsomorphism f x y   checkZeroAndOne x   checkDistributive x y r s