clifford 0.1.0.10 → 0.1.0.11
raw patch · 4 files changed
+32/−6 lines, 4 files
Files
- changelog.md +1/−0
- clifford.cabal +1/−1
- src/Numeric/Clifford/Blade.lhs +9/−3
- src/Numeric/Clifford/Multivector.lhs +21/−2
changelog.md view
@@ -1,4 +1,5 @@ -*-change-log-*-+ 0.1.0.11 More inlining and specialisation 0.1.0.10 Fixed compile error whoops 0.1.0.9 Inlined/specialised a bunch of function, hueg speed increase 0.1.0.8 Implemented algebraic/transcendental typeclasses
clifford.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.1.0.10+version: 0.1.0.11 -- A short (one-line) description of the package. synopsis: A Clifford algebra library
src/Numeric/Clifford/Blade.lhs view
@@ -75,8 +75,10 @@ dimension :: forall (p::Nat) (q::Nat) f. (SingI p, SingI q) => Blade p q f -> (Natural,Natural) dimension _ = (toNatural ((GHC.Real.fromIntegral $ fromSing (sing :: Sing p))::Word),toNatural((GHC.Real.fromIntegral $ fromSing (sing :: Sing q))::Word)) +{-#INLINE bScale #-} bScale :: Blade p q f -> f bScale b = b^.scale+{-#INLINE bIndices #-} bIndices :: Blade p q f -> [Natural] bIndices b = b^.indices instance (Control.DeepSeq.NFData f) => Control.DeepSeq.NFData (Blade p q f)@@ -110,9 +112,15 @@ bladeNegate :: (Algebra.Additive.C f) => Blade p q f -> Blade p q f bladeNegate b = b&scale%~negate --Blade (Algebra.Additive.negate$ b^.scale) (b^.indices) +{-#INLINE bladeScaleLeft #-}+{-#SPECIALISE bladeScaleLeft::Double->STBlade -> STBlade#-}+{-#SPECIALISE bladeScaleLeft::Double->E3Blade -> E3Blade#-} bladeScaleLeft :: f -> Blade p q f -> Blade p q f bladeScaleLeft s (Blade f ind) = Blade (s * f) ind bladeScaleRight :: f -> Blade p q f -> Blade p q f+{-#INLINE bladeScaleRight #-}+{-#SPECIALISE bladeScaleRight::Double->STBlade -> STBlade#-}+{-#SPECIALISE bladeScaleRight::Double->E3Blade -> E3Blade#-} bladeScaleRight s (Blade f ind) = Blade (f * s) ind \end{code} @@ -136,9 +144,7 @@ result = if (any (\i -> (GHC.Real.toInteger i) >= d) indices) then zeroBlade else Blade scale' newIndices p' = (fromSing (sing :: Sing p)) :: Integer q' = (fromSing (sing :: Sing q)) :: Integer- d = p' + q'- - + d = p' + q' scale' = if doNotNegate then scale else negate scale (newIndices, doNotNegate) = sortIndices (indices,q')
src/Numeric/Clifford/Multivector.lhs view
@@ -207,7 +207,7 @@ {-{-# RULES- "turn multiple additions into sumList" forall (f::Algebra.Field.C) (a::Multivector p q f) b c . (+) a ((+) b c) = sumList [a,b,c]+ "turn multiple additions into sumList" forall (a::Multivector (p::Nat) (q::Nat) (Algebra.Field.C f)) (b::Multivector (p::Nat) (q::Nat) (Algebra.Field.C f)) (c::Multivector (p::Nat) (q::Nat) (Algebra.Field.C f)) . (+) a ((+) b c) = sumList [a,b,c] #-}-} {-#RULES "sumList[..] + a = sumList [..,a]" forall (a::Multivector (p::Nat) (q::Nat) (Algebra.Field.C f)) xs. (+) (sumList xs) a = sumList (a:xs)@@ -217,8 +217,12 @@ #-} instance (Algebra.Field.C f, Ord f, SingI p, SingI q) => Algebra.Additive.C (Multivector p q f) where {-#INLINE (+)#-}+ {-#SPECIALISE (+)::STVector -> STVector -> STVector #-}+ {-#SPECIALISE (+)::E3Vector -> E3Vector -> E3Vector #-} a + b = mvNormalForm $ BladeSum (mvTerms a ++ mvTerms b) {-#INLINE (-)#-}+ {-#SPECIALISE (-)::STVector -> STVector -> STVector #-}+ {-#SPECIALISE (-)::E3Vector -> E3Vector -> E3Vector #-} a - b = mvNormalForm $ BladeSum (mvTerms a ++ map bladeNegate (mvTerms b)) zero = BladeSum [scalarBlade Algebra.Additive.zero] @@ -228,9 +232,19 @@ Now it is time for the Clifford product. :3 \begin{code}-+{-{-# RULES+ "turn multiple multiplications into multiplyList1" forall (a::Multivector (p::Nat) (q::Nat) (Algebra.Field.C f)) b c . (*) ((*) a b) c = multiplyList1 [a,b,c]+ #-}-}+{-#RULES+ "multiplyList1[..] * a = multiplyList1 [..,a]" forall (a::Multivector (p::Nat) (q::Nat) (Algebra.Field.C f)) xs. (*) (multiplyList1 xs) a = multiplyList1 (concat [xs,[a]])+ #-}+{-# RULES+ "a* multiplyList1[..] = multiplyList1 [..,a]" forall (a::Multivector p q (Algebra.Field.C f)) xs. (*) a (multiplyList1 xs) = multiplyList1 (a:xs)+ #-} instance (Algebra.Field.C f, Ord f, SingI p, SingI q) => Algebra.Ring.C (Multivector p q f) where {-#INLINE (*)#-}+ {-#SPECIALISE (*)::STVector ->STVector -> STVector#-}+ {-#SPECIALISE (*)::E3Vector ->E3Vector ->E3Vector #-} BladeSum [Blade s []] * b = BladeSum $ map (bladeScaleLeft s) $ mvTerms b a * BladeSum [Blade s []] = BladeSum $ map (bladeScaleRight s) $ mvTerms a a * b = mvNormalForm $ BladeSum [bladeMul x y | x <- mvTerms a, y <- mvTerms b]@@ -273,6 +287,9 @@ instance (Algebra.Field.C f, Ord f, SingI p, SingI q) => Algebra.Module.C f (Multivector p q f) where -- (*>) zero v = Algebra.Additive.zero+ {-#INLINE (*>) #-}+ {-#SPECIALISE INLINE (*>) :: Double -> STVector -> STVector #-}+ {-#SPECIALISE INLINE (*>) :: Double -> E3Vector -> E3Vector #-} (*>) s v = v & mvTerms & map (bladeScaleLeft s) & BladeSum @@ -410,6 +427,8 @@ reverseMultivector v = mvNormalForm $ v & terms.traverse%~ reverseBlade {-#INLINE inverse#-}+{-#SPECIALISE INLINE inverse :: STVector -> STVector #-}+{-# SPECIALISE INLINE inverse :: E3Vector -> E3Vector #-} inverse a@(BladeSum _) = assert (a /= zero) $ (recip scalarComponent) *> (reverseMultivector a) where scalarComponent = bScale (head $ mvTerms (a * reverseMultivector a))