clifford 0.1.0.12 → 0.1.0.13
raw patch · 8 files changed
+82/−18 lines, 8 filesdep +monoid-extrasdep +semigroupoids
Dependencies added: monoid-extras, semigroupoids
Files
- changelog.md +1/−0
- clifford.cabal +2/−2
- src/Numeric/Clifford/Blade.lhs +6/−6
- src/Numeric/Clifford/ClassicalMechanics.lhs +2/−2
- src/Numeric/Clifford/Internal.hs +3/−1
- src/Numeric/Clifford/LinearOperators.lhs +57/−6
- src/Numeric/Clifford/Multivector.lhs +8/−1
- src/Numeric/Clifford/NumericIntegration.lhs +3/−0
changelog.md view
@@ -1,4 +1,5 @@ -*-change-log-*-+ 0.1.0.13 Adding ability to create linear operators from matrices; made linear operators a category and monoid 0.1.0.12 Adding type signatures to top level stuff 0.1.0.11 More inlining and specialisation 0.1.0.10 Fixed compile error whoops
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.12+version: 0.1.0.13 -- A short (one-line) description of the package. synopsis: A Clifford algebra library@@ -61,7 +61,7 @@ -- Other library packages from which modules are imported. build-depends: base >=4.6 && <4.9, numeric-prelude >= 0.4.0.1 && < 0.5.0, permutation >= 0.4.1 && < 0.5, data-ordlist >= 0.4.5 && < 0.5, converge >= 0.1.0.1 && < 0.2, lens >= 4.0.3 && < 4.1, - deepseq >= 1.3.0.1 && < 1.4, vector >= 0.10.0.1 && < 0.11, stream-fusion >= 0.1 && < 0.2, criterion >= 0.8.0.0 && < 0.9, derive, QuickCheck, nats, tagged, cereal,hspec, MemoTrie >= 0.6 && < 0.7+ deepseq >= 1.3.0.1 && < 1.4, vector >= 0.10.0.1 && < 0.11, stream-fusion >= 0.1 && < 0.2, criterion >= 0.8.0.0 && < 0.9, derive, QuickCheck, nats, tagged, cereal,hspec, MemoTrie >= 0.6 && < 0.7, semigroupoids >= 4.0 && < 4.1, monoid-extras >=0.3 && <0.4 ghc-options: -fllvm -fexcess-precision -optlc-O=3 -O3 -- Directories containing source files.
src/Numeric/Clifford/Blade.lhs view
@@ -64,12 +64,12 @@ \begin{code} data Blade (p :: Nat) (q :: Nat) f where- Blade :: forall p q f . (SingI p, SingI q, Algebra.Field.C f) => {_scale :: f, _indices :: [Natural]} -> Blade p q f+ Blade :: forall (p::Nat) (q::Nat) f . (Algebra.Field.C f, SingI p, SingI q) => {_scale :: f, _indices :: [Natural]} -> Blade p q f type STBlade = Blade 3 1 Double type E3Blade = Blade 3 0 Double-scale :: Lens' (Blade p q f) f-scale = lens _scale (\blade v -> blade {_scale = v})+--scale :: Lens (Blade p q f) (Blade p q g) f g+scale = lens _scale (\b@(Blade _ ind) v -> Blade v ind) indices :: Lens' (Blade p q f) [Natural] indices = lens _indices (\blade v -> blade {_indices = v}) dimension :: forall (p::Nat) (q::Nat) f. (SingI p, SingI q) => Blade p q f -> (Natural,Natural)@@ -77,7 +77,7 @@ {-#INLINE bScale #-} bScale :: Blade p q f -> f-bScale b = b^.scale+bScale b@(Blade _ _) = b^.scale {-#INLINE bIndices #-} bIndices :: Blade p q f -> [Natural] bIndices b = b^.indices@@ -107,10 +107,10 @@ zeroBlade = scalarBlade Algebra.Additive.zero bladeNonZero :: (Algebra.Additive.C f, Eq f) => Blade p q f -> Bool-bladeNonZero b = b^.scale /= Algebra.Additive.zero+bladeNonZero b@(Blade _ _) = b^.scale /= Algebra.Additive.zero 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)+bladeNegate b@(Blade _ _) = b&scale%~negate --Blade (Algebra.Additive.negate$ b^.scale) (b^.indices) {-#INLINE bladeScaleLeft #-} {-#SPECIALISE bladeScaleLeft::Double->STBlade -> STBlade#-}
src/Numeric/Clifford/ClassicalMechanics.lhs view
@@ -80,9 +80,9 @@ Now to make a physical object. \begin{code}-data ReferenceFrame (p::Nat) (q::Nat) t = ReferenceFrame {basisVectors :: [Multivector p q t]}+data ReferenceFrame (p::Nat) (q::Nat) t = ReferenceFrame {basisFrame :: [Multivector p q t]} psuedoScalar' :: forall f (p::Nat) (q::Nat). (Ord f, Algebra.Field.C f, SingI p, SingI q) => ReferenceFrame p q f -> Multivector p q f-psuedoScalar' = multiplyList . basisVectors+psuedoScalar' = multiplyList . basisFrame
src/Numeric/Clifford/Internal.hs view
@@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fllvm -fexcess-precision -optlo-O3 -O3 -optlc-O=3 -Wall #-} {-# LANGUAGE TypeOperators, TypeFamilies,CPP #-}-module Numeric.Clifford.Internal (myTrace, trie, untrie, enumerate) where+module Numeric.Clifford.Internal (myTrace, trie, untrie, enumerate, dimension) where import Numeric.Natural import Prelude hiding (head,tail, null) import Data.MemoTrie@@ -21,6 +21,8 @@ untrie (NaturalTrie t) = untrie t . bitsZ enumerate (NaturalTrie t) = enum' unbitsZ t +dimension :: Natural -> Natural -> Natural+dimension p q = pred $ p + q instance Arbitrary Natural where arbitrary = sized $ \n ->
src/Numeric/Clifford/LinearOperators.lhs view
@@ -1,32 +1,83 @@ \begin{code}-{-# LANGUAGE NoImplicitPrelude, RankNTypes #-}+{-# LANGUAGE NoImplicitPrelude, RankNTypes, KindSignatures, DataKinds, GADTs, FlexibleInstances, UndecidableInstances, InstanceSigs, MultiParamTypeClasses #-} module Numeric.Clifford.LinearOperators where-import NumericPrelude+import qualified NumericPrelude as NP ((.), id)+import NumericPrelude hiding ((.), id, (!!), zipWith, map, length) import Numeric.Clifford.Multivector import Algebra.Algebraic+import Algebra.Field+import Algebra.Ring import Algebra.Transcendental import GHC.TypeLits+import Data.Monoid+import Control.Applicative+import Control.Category+import Control.Arrow+import Control.Monad+import Data.List.Stream+import qualified Control.Lens+import Control.Lens.Operators+import Data.Semigroupoid+import Numeric.Natural+import Data.Word+import Numeric.Clifford.Internal+import qualified Numeric.Clifford.Blade \end{code} What is a linear operator? Just a Vector -> Vector! \begin{code}-type LinearOperator p q f = Multivector p q f -> Multivector p q f++-- linear operators appear to satisfy monad laws. possible design: use accumulate operator elements, simplify them down to a single operator, and then apply that to a multivector+data LinearOperator' p q f g where+ LinearOperator' :: {_operator' :: Multivector p q f -> Multivector p q g} -> LinearOperator' p q f g+ LinearOperator :: {_operator :: Multivector p q f -> Multivector p q f} -> LinearOperator' p q f f+type LinearOperator p q f = LinearOperator' p q f f type LinearOperatorCreator p q f = (Algebra.Algebraic.C f, Ord f, SingI p, SingI q) => Multivector p q f -> LinearOperator p q f +instance Category (LinearOperator' p q) where+ id = LinearOperator' NP.id+ (.) (LinearOperator' a) (LinearOperator' b) = LinearOperator' (a NP.. b)++instance (Algebra.Field.C f, Ord f,Algebra.Field.C g, Ord g, SingI p, SingI q, f~g) => Monoid (LinearOperator' p q f g) where+ mempty = id+ mappend = (.)+++++class LinearOperatorClass' (p::Nat) (q::Nat) f g where++{-+[[f11, f12, f13],+ [f21, f22, f21],+ [f31, f32, f33]]+-}+createFunctionalFromElements :: forall (p::Nat) (q::Nat) f . (Algebra.Field.C f, Ord f, SingI p, SingI q) => [[f]] ->(Multivector p q f -> Multivector p q f)+createFunctionalFromElements elements = (\x -> f*x) where+ d = (length elements) - 1+ f = sumList $ map elementsForK [0..d]+ column k = let transposed = transpose elements in transposed !! k + elementsForK k =sumList $ zipWith (scaleRight) basisVectors (column k) + +createLinearOperatorFromElements :: forall (p::Nat) (q::Nat) f . (Algebra.Field.C f, Ord f, SingI p, SingI q) => [[f]] -> LinearOperator p q f+createLinearOperatorFromElements = LinearOperator . createFunctionalFromElements++ reflect u x = (-u)*x*recip u makeReflectionOperator ::LinearOperatorCreator p q f-makeReflectionOperator u = reflect u+makeReflectionOperator u = LinearOperator (reflect u) rotate spinor x = (reverseMultivector spinor) * x * spinor rotatePlaneAngle plane angle = rotate (exp (((fst.normalised) plane) * (angle/2))) makeRotationOperator :: LinearOperatorCreator p q f-makeRotationOperator u = rotate u+makeRotationOperator u = LinearOperator (rotate u) +makeRotationOperatorFromPlaneAngle plane angle = LinearOperator (rotatePlaneAngle plane angle) project u x = inverse u * (u `dot` x) makeProjectionOperator :: LinearOperatorCreator p q f-makeProjectionOperator u = project u+makeProjectionOperator u = LinearOperator (project u) \end{code}
src/Numeric/Clifford/Multivector.lhs view
@@ -86,7 +86,7 @@ \begin{code} data Multivector (p::Nat) (q::Nat) f where- BladeSum :: forall p q f . (Ord f, Algebra.Field.C f, SingI p, SingI q) => { _terms :: [Blade p q f]} -> Multivector p q f+ BladeSum :: forall (p::Nat) (q::Nat) f . (Ord f, Algebra.Field.C f,SingI p, SingI q) => { _terms :: [Blade p q f]} -> Multivector p q f type STVector = Multivector 3 1 Double type E3Vector = Multivector 3 0 Double@@ -106,6 +106,13 @@ signature :: forall (p::Nat) (q::Nat) f. (SingI p, SingI q) => Multivector p q f -> (Natural,Natural) signature _ = (toNatural ((fromIntegral $ fromSing (sing :: Sing p))::Word),toNatural ((fromIntegral $ fromSing (sing :: Sing q))::Word))++basisVectors :: forall (p::Nat) (q::Nat) f . (Algebra.Field.C f, Ord f, SingI p, SingI q) => [Multivector p q f]+basisVectors = map (sigma) [0..d] where+ sigma :: Natural -> Multivector p q f+ sigma j = (Algebra.Ring.one) `e` [j] + d = let (p', q') = signature (undefined :: Multivector p q f) in pred ( (PNum.+) p' q')+ terms :: Lens' (Multivector p q f) [Blade p q f] terms = lens _terms (\bladeSum v -> bladeSum {_terms = v})
src/Numeric/Clifford/NumericIntegration.lhs view
@@ -155,6 +155,9 @@ b i = l !! (i - 1) where l = _tableauB tableau + {-#INLINE sumListOfLists #-}+-- {-#SPECIALISE INLINE sumListOfLists :: [[STVector]]->[STVector]#-}+-- {-#SPECIALISE INLINE sumListOfLists :: [[Vector]]->[E3Vector]#-} sumListOfLists :: [[Multivector p q t]] -> [Multivector p q t] sumListOfLists = map sumList . transpose