packages feed

vector-space 0.5.3 → 0.5.6

raw patch · 7 files changed

+300/−102 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Data.LinearMap: compL :: (HasBasis u, HasTrie (Basis u), HasBasis v, HasTrie (Basis v), VectorSpace w, (Scalar v) ~ (Scalar w)) => (v :-* w) -> (u :-* v) -> (u :-* w)
- Data.Maclaurin: instance (HasBasis a, HasTrie (Basis a), VectorSpace u) => VectorSpace (a :> u)
+ Data.AdditiveGroup: getSum :: Sum a -> a
+ Data.AdditiveGroup: inSum :: (a -> b) -> (Sum a -> Sum b)
+ Data.AdditiveGroup: inSum2 :: (a -> b -> c) -> (Sum a -> Sum b -> Sum c)
+ Data.AdditiveGroup: instance (AdditiveGroup a) => AdditiveGroup (Sum a)
+ Data.AdditiveGroup: instance (AdditiveGroup u, AdditiveGroup v, AdditiveGroup w, AdditiveGroup x) => AdditiveGroup (u, v, w, x)
+ Data.AdditiveGroup: instance AdditiveGroup Int
+ Data.AdditiveGroup: instance AdditiveGroup Integer
+ Data.LinearMap: (*.*) :: (HasBasis u, HasTrie (Basis u), HasBasis v, HasTrie (Basis v), VectorSpace w, (Scalar v) ~ (Scalar w)) => (v :-* w) -> (u :-* v) -> (u :-* w)
+ Data.LinearMap: atBasis :: (HasTrie a, AdditiveGroup b) => MSum (a :->: b) -> a -> b
+ Data.LinearMap: liftL :: (Functor f, AdditiveGroup (f a)) => (a -> b) -> MSum (f a) -> MSum (f b)
+ Data.LinearMap: liftL2 :: (Applicative f, AdditiveGroup (f a), AdditiveGroup (f b)) => (a -> b -> c) -> (MSum (f a) -> MSum (f b) -> MSum (f c))
+ Data.LinearMap: liftL3 :: (Applicative f, AdditiveGroup (f a), AdditiveGroup (f b), AdditiveGroup (f c)) => (a -> b -> c -> d) -> (MSum (f a) -> MSum (f b) -> MSum (f c) -> MSum (f d))
+ Data.LinearMap: liftMS :: (AdditiveGroup a) => (a -> b) -> (MSum a -> MSum b)
+ Data.LinearMap: liftMS2 :: (AdditiveGroup a, AdditiveGroup b) => (a -> b -> c) -> (MSum a -> MSum b -> MSum c)
+ Data.LinearMap: liftMS3 :: (AdditiveGroup a, AdditiveGroup b, AdditiveGroup c) => (a -> b -> c -> d) -> (MSum a -> MSum b -> MSum c -> MSum d)
+ Data.Maclaurin: D :: b -> a :-* (a :> b) -> :> a b
+ Data.Maclaurin: derivAtBasis :: (HasTrie (Basis a), HasBasis a, AdditiveGroup b) => (a :> b) -> (Basis a -> (a :> b))
+ Data.Maclaurin: instance (HasBasis a, HasTrie (Basis a), VectorSpace u, AdditiveGroup (Scalar u)) => VectorSpace (a :> u)
+ Data.Maclaurin: pairD :: (HasBasis a, HasTrie (Basis a), VectorSpace b, VectorSpace c, (Scalar b) ~ (Scalar c)) => (a :> b, a :> c) -> a :> (b, c)
+ Data.Maclaurin: tripleD :: (HasBasis a, HasTrie (Basis a), VectorSpace b, VectorSpace c, VectorSpace d, (Scalar b) ~ (Scalar c), (Scalar c) ~ (Scalar d)) => (a :> b, a :> c, a :> d) -> a :> (b, c, d)
+ Data.Maclaurin: unpairD :: (HasBasis a, HasTrie (Basis a), VectorSpace a, VectorSpace b, VectorSpace c, (Scalar b) ~ (Scalar c)) => (a :> (b, c)) -> (a :> b, a :> c)
+ Data.Maclaurin: untripleD :: (HasBasis a, HasTrie (Basis a), VectorSpace a, VectorSpace b, VectorSpace c, VectorSpace d, (Scalar b) ~ (Scalar c), (Scalar c) ~ (Scalar d)) => (a :> (b, c, d)) -> (a :> b, a :> c, a :> d)
+ Data.VectorSpace: instance (s ~ Scalar u, s ~ Scalar v, s ~ Scalar w, s ~ Scalar x, InnerSpace u, InnerSpace v, InnerSpace w, InnerSpace x, AdditiveGroup s) => InnerSpace (u, v, w, x)
+ Data.VectorSpace: instance (s ~ Scalar u, s ~ Scalar v, s ~ Scalar w, s ~ Scalar x, VectorSpace u, VectorSpace v, VectorSpace w, VectorSpace x) => VectorSpace (u, v, w, x)
- Data.LinearMap: type :-* u v = Basis u :->: v
+ Data.LinearMap: type :-* u v = MSum (Basis u :->: v)
- Data.Maclaurin: (<$>>) :: (HasTrie (Basis a)) => (b -> c) -> (a :> b) -> (a :> c)
+ Data.Maclaurin: (<$>>) :: (HasBasis a, HasTrie (Basis a), AdditiveGroup b) => (b -> c) -> (a :> b) -> (a :> c)
- Data.Maclaurin: (>-<) :: (HasBasis a, HasTrie (Basis a), VectorSpace u) => (u -> u) -> ((a :> u) -> (a :> Scalar u)) -> (a :> u) -> (a :> u)
+ Data.Maclaurin: (>-<) :: (HasBasis a, HasTrie (Basis a), VectorSpace u, AdditiveGroup (Scalar u)) => (u -> u) -> ((a :> u) -> (a :> Scalar u)) -> (a :> u) -> (a :> u)
- Data.Maclaurin: distrib :: (HasBasis a, HasTrie (Basis a), AdditiveGroup u) => (b -> c -> u) -> (a :> b) -> (a :> c) -> (a :> u)
+ Data.Maclaurin: distrib :: (HasBasis a, HasTrie (Basis a), AdditiveGroup b, AdditiveGroup c, AdditiveGroup u) => (b -> c -> u) -> (a :> b) -> (a :> c) -> (a :> u)
- Data.Maclaurin: fmapD :: (HasTrie (Basis a)) => (b -> c) -> (a :> b) -> (a :> c)
+ Data.Maclaurin: fmapD :: (HasBasis a, HasTrie (Basis a), AdditiveGroup b) => (b -> c) -> (a :> b) -> (a :> c)
- Data.Maclaurin: liftD2 :: (HasTrie (Basis a)) => (b -> c -> d) -> (a :> b) -> (a :> c) -> (a :> d)
+ Data.Maclaurin: liftD2 :: (HasBasis a, HasTrie (Basis a), AdditiveGroup b, AdditiveGroup c) => (b -> c -> d) -> (a :> b) -> (a :> c) -> (a :> d)
- Data.Maclaurin: liftD3 :: (HasTrie (Basis a)) => (b -> c -> d -> e) -> (a :> b) -> (a :> c) -> (a :> d) -> (a :> e)
+ Data.Maclaurin: liftD3 :: (HasBasis a, HasTrie (Basis a), AdditiveGroup b, AdditiveGroup c, AdditiveGroup d) => (b -> c -> d -> e) -> (a :> b) -> (a :> c) -> (a :> d) -> (a :> e)

Files

src/Data/AdditiveGroup.hs view
@@ -13,7 +13,8 @@  module Data.AdditiveGroup   ( -    AdditiveGroup(..), (^-^), sumV, Sum(..)+    AdditiveGroup(..), (^-^), sumV+  , Sum(..), inSum, inSum2   ) where  import Control.Applicative@@ -47,16 +48,16 @@   () ^+^ () = ()   negateV   = id -instance AdditiveGroup Double where-  zeroV   = 0.0-  (^+^)   = (+)-  negateV = negate+-- For 'Num' types:+-- +-- instance AdditiveGroup n where {zeroV=0; (^+^) = (+); negateV = negate} -instance AdditiveGroup Float where-  zeroV   = 0.0-  (^+^)   = (+)-  negateV = negate+instance AdditiveGroup Int     where {zeroV=0; (^+^) = (+); negateV = negate}+instance AdditiveGroup Integer where {zeroV=0; (^+^) = (+); negateV = negate}+instance AdditiveGroup Float   where {zeroV=0; (^+^) = (+); negateV = negate}+instance AdditiveGroup Double  where {zeroV=0; (^+^) = (+); negateV = negate} + instance (RealFloat v, AdditiveGroup v) => AdditiveGroup (Complex v) where   zeroV   = zeroV :+ zeroV   (^+^)   = (+)@@ -77,7 +78,13 @@   (u,v,w) ^+^ (u',v',w') = (u^+^u',v^+^v',w^+^w')   negateV (u,v,w)        = (negateV u,negateV v,negateV w) +instance (AdditiveGroup u,AdditiveGroup v,AdditiveGroup w,AdditiveGroup x)+    => AdditiveGroup (u,v,w,x) where+  zeroV                       = (zeroV,zeroV,zeroV,zeroV)+  (u,v,w,x) ^+^ (u',v',w',x') = (u^+^u',v^+^v',w^+^w',x^+^x')+  negateV (u,v,w,x)           = (negateV u,negateV v,negateV w,negateV x) + -- Standard instance for an applicative functor applied to a vector space. instance AdditiveGroup v => AdditiveGroup (a -> v) where   zeroV   = pure   zeroV@@ -103,17 +110,49 @@  -- | Monoid under group addition.  Alternative to the @Sum@ in -- "Data.Monoid", which uses 'Num' instead of 'AdditiveGroup'.-newtype Sum a = Sum a+newtype Sum a = Sum { getSum :: a }   deriving (Eq, Ord, Read, Show, Bounded)  instance Functor Sum where   fmap f (Sum a) = Sum (f a) +-- instance Applicative Sum where+--   pure a = Sum a+--   Sum f <*> Sum x = Sum (f x)+ instance Applicative Sum where-  pure a = Sum a-  Sum f <*> Sum x = Sum (f x)+  pure  = Sum+  (<*>) = inSum2 ($)  instance AdditiveGroup a => Monoid (Sum a) where   mempty  = Sum zeroV   mappend = liftA2 (^+^) ++-- | Application a unary function inside a 'Sum'+inSum :: (a -> b) -> (Sum a -> Sum b)+inSum = getSum ~> Sum++-- | Application a binary function inside a 'Sum'+inSum2 :: (a -> b -> c) -> (Sum a -> Sum b -> Sum c)+inSum2 = getSum ~> inSum+++instance AdditiveGroup a => AdditiveGroup (Sum a) where+  zeroV   = mempty+  (^+^)   = mappend+  negateV = inSum negateV+++---- to go elsewhere++(~>) :: (a' -> a) -> (b -> b') -> ((a -> b) -> (a' -> b'))+(i ~> o) f = o . f . i++-- result :: (b -> b') -> ((a -> b) -> (a -> b'))+-- result = (.)++-- argument :: (a' -> a) -> ((a -> b) -> (a' -> b))+-- argument = flip (.)++-- g ~> f = result g . argument f
src/Data/Basis.hs view
@@ -27,6 +27,9 @@  import Data.VectorSpace +-- using associated data type instead of associated type synonym to work+-- around ghc bug <http://hackage.haskell.org/trac/ghc/ticket/3038>+ class VectorSpace v => HasBasis v where   -- | Representation of the canonical basis for @v@   type Basis v :: *
src/Data/Cross.hs view
@@ -25,9 +25,7 @@ import Data.MemoTrie import Data.Basis --- import Data.LinearMap import Data.Derivative--- import Data.Maclaurin  -- | Thing with a normal vector (not necessarily normalized). class HasNormal v where normalVec :: v -> v@@ -58,8 +56,24 @@  instance (HasBasis s, HasTrie (Basis s), Basis s ~ ()) =>          HasNormal (One s :> Two s) where-  normalVec v = cross2 (derivative v `untrie` ())+  normalVec v = cross2 (v `derivAtBasis` ()) +-- When I use atBasis (from LinearMap) instead of the more liberally-typed+-- atB (below), I get a type error:+-- +--     Couldn't match expected type `Basis a1' against inferred type `()'+--       Expected type: a1 :-* (s :> Two s)+--       Inferred type: s  :-* (s :> Two s)+--     In the first argument of `atB', namely `derivative v'+-- +-- I think this type error is a GHC bug, but I'm not sure.++-- atB :: (AdditiveGroup b, HasTrie a) => Maybe (a :->: b) -> a -> b+-- -- atB :: (AdditiveGroup b, HasBasis a, HasTrie (Basis a)) =>+-- --        Maybe (Basis a :->: b) -> Basis a -> b+-- l `atB` b = maybe zeroV (`untrie` b) l++ instance ( Num s, VectorSpace s          , HasBasis s, HasTrie (Basis s), Basis s ~ ())     => HasNormal (Two (One s :> s)) where@@ -86,38 +100,9 @@          HasNormal (Two s :> Three s) where   normalVec v = d (Left ()) `cross3` d (Right ())    where-     d = untrie (derivative v)+     d = derivAtBasis v  instance ( Num s, VectorSpace s, HasBasis s, HasTrie (Basis s)          , HasNormal (Two s :> Three s))          => HasNormal (Three (Two s :> s)) where   normalVec = untripleD . normalVec . tripleD------- Could go elsewhere--pairD :: ( HasBasis a, HasTrie (Basis a)-         , VectorSpace b, VectorSpace c-         , Scalar b ~ Scalar c-         ) => (a:>b,a:>c) -> a:>(b,c)-pairD (u,v) = liftD2 (,) u v--tripleD :: ( HasBasis a, HasTrie (Basis a)-           , VectorSpace b, VectorSpace c, VectorSpace d-           , Scalar b ~ Scalar c, Scalar c ~ Scalar d-           ) => (a:>b,a:>c,a:>d) -> a:>(b,c,d)-tripleD (u,v,w) = liftD3 (,,) u v w--unpairD :: ( HasBasis a, HasTrie (Basis a)-           , VectorSpace a, VectorSpace b, VectorSpace c-           , Scalar b ~ Scalar c-           ) => (a :> (b,c)) -> (a:>b, a:>c)-unpairD d = (fst <$>> d, snd <$>> d)--untripleD :: ( HasBasis a, HasTrie (Basis a)-             , VectorSpace a, VectorSpace b, VectorSpace c, VectorSpace d-             , Scalar b ~ Scalar c, Scalar c ~ Scalar d-             ) =>-             (a :> (b,c,d)) -> (a:>b, a:>c, a:>d)-untripleD d =-  ((\ (a,_,_) -> a) <$>> d, (\ (_,b,_) -> b) <$>> d, (\ (_,_,c) -> c) <$>> d)
src/Data/LinearMap.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeOperators, FlexibleContexts, TypeFamilies, CPP #-}+{-# LANGUAGE TypeOperators, FlexibleContexts, TypeFamilies #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} -- {-# OPTIONS_GHC -funbox-strict-fields #-} -- {-# OPTIONS_GHC -ddump-simpl-stats -ddump-simpl #-}@@ -15,51 +15,119 @@ ----------------------------------------------------------------------  module Data.LinearMap-  ( (:-*) , linear, lapply, idL, compL+  ( (:-*) , linear, lapply, atBasis, idL, (*.*)+  , liftMS, liftMS2, liftMS3+  , liftL, liftL2, liftL3   ) where -import Control.Arrow (first)+import Control.Applicative ((<$>),Applicative,liftA2,liftA3)+import Control.Arrow       (first) -import Data.MemoTrie    ((:->:)(..))-import Data.VectorSpace (VectorSpace(..))-import Data.Basis       (HasBasis(..), linearCombo)+import Data.MemoTrie      ((:->:)(..))+import Data.AdditiveGroup (Sum(..),inSum2, AdditiveGroup(..))+import Data.VectorSpace   (VectorSpace(..))+import Data.Basis         (HasBasis(..), linearCombo)   -- Linear maps are almost but not quite a Control.Category.  The type -- class constraints interfere.  They're almost an Arrow also, but for the -- constraints and the generality of arr. --- | Linear map, represented as a memo-trie from basis to values.-type u :-* v = Basis u :->: v+-- | An optional additive value+type MSum a = Maybe (Sum a) +-- nsum :: MSum a+-- nsum = Nothing --- TODO: Use a regular function from @Basis u@, but memoize it.+jsum :: a -> MSum a+jsum = Just . Sum +-- | Linear map, represented as an optional memo-trie from basis to+-- values, where 'Nothing' means the zero map (an optimization).+type u :-* v = MSum (Basis u :->: v)++-- TODO: Try a partial trie instead, excluding (known) zero elements.+-- Then 'lapply' could be much faster for sparse situations.  Make sure to+-- correctly sum them.  It'd be more like Jason Foutz's formulation+-- <http://metavar.blogspot.com/2008/02/higher-order-multivariate-automatic.html>+-- which uses in @IntMap@.+++-- PROBLEM: u :-* v is a type synonym, and Basis is an associated type synonym, resulting in a subtle+-- ambiguity: u:-*v == u':-*v' does not imply that u==u', since Basis+-- might map different types to the same basis (e.g., Float & Double).+-- See <http://hackage.haskell.org/trac/ghc/ticket/1897>+-- +-- Work in progress.  See NewLinearMap.hs++ -- | Function (assumed linear) as linear map. linear :: (HasBasis u, HasTrie (Basis u)) =>           (u -> v) -> (u :-* v)-linear f = trie (f . basisValue)+linear f = jsum (trie (f . basisValue)) +atZ :: AdditiveGroup b => (a -> b) -> (MSum a -> b)+atZ f = maybe zeroV (f . getSum)++-- atZ :: AdditiveGroup b => (a -> b) -> (a -> b)+-- atZ = id++-- | Evaluate a linear map on a basis element.  I've loosened the type to+-- work around a typing problem in 'derivAtBasis'.+-- atBasis :: (AdditiveGroup v, HasTrie (Basis u)) =>+--            (u :-* v) -> Basis u -> v+atBasis :: (HasTrie a, AdditiveGroup b) => MSum (a :->: b) -> a -> b+m `atBasis` b = atZ (`untrie` b) m+ -- | Apply a linear map to a vector. lapply :: ( VectorSpace v, Scalar u ~ Scalar v           , HasBasis u, HasTrie (Basis u) ) =>           (u :-* v) -> (u -> v)-lapply tr = linearCombo . fmap (first (untrie tr)) . decompose+lapply = atZ lapply' +-- Handy for 'lapply' and '(*.*)'.+lapply' :: ( VectorSpace v, Scalar u ~ Scalar v+           , HasBasis u, HasTrie (Basis u) ) =>+           (Basis u :->: v) -> (u -> v)+lapply' tr = linearCombo . fmap (first (untrie tr)) . decompose ++ -- Identity linear map idL :: (HasBasis u, HasTrie (Basis u)) =>         u :-* u idL = linear id ++infixr 9 *.* -- | Compose linear maps-compL :: ( HasBasis u, HasTrie (Basis u)+(*.*) :: ( HasBasis u, HasTrie (Basis u)          , HasBasis v, HasTrie (Basis v)-         , VectorSpace w, Scalar v ~ Scalar w ) =>+         , VectorSpace w+         , Scalar v ~ Scalar w ) =>          (v :-* w) -> (u :-* v) -> (u :-* w) -compL vw = fmap (lapply vw)+-- Simple definition, but only optimizes out uv == zero+-- +-- (*.*) vw = (fmap.fmap) (lapply vw) +-- Instead, use Nothing/zero if /either/ map is zeroV (exploiting linearity+-- when uv == zeroV.)++-- Nothing       *.* _             = Nothing+-- _             *.* Nothing       = Nothing+-- Just (Sum vw) *.* Just (Sum uv) = Just (Sum (lapply' vw <$> uv))++-- (*.*) = liftA2 (\ (Sum vw) (Sum uv) -> Sum (lapply' vw <$> uv))++-- (*.*) = (liftA2.inSum2) (\ vw uv -> lapply' vw <$> uv)+(*.*) = (liftA2.inSum2) (\ vw uv -> lapply' vw <$> uv)++-- (*.*) = (liftA2.inSum2) (\ vw -> fmap (lapply' vw))++-- (*.*) = (liftA2.inSum2) (fmap . lapply')++ -- It may be helpful that @lapply vw@ is evaluated just once and not -- once per uv.  'untrie' can strip off all of its trie constructors. @@ -72,3 +140,49 @@ -- The problem with these definitions is that basis elements get converted -- to values and then decomposed, followed by recombination of the -- results.++liftMS :: (AdditiveGroup a) =>+          (a -> b)+       -> (MSum a -> MSum b)+-- liftMS _ Nothing = Nothing+-- liftMS h ma = Just (Sum (h (z ma)))++liftMS = fmap.fmap++liftMS2 :: (AdditiveGroup a, AdditiveGroup b) =>+           (a -> b -> c) ->+           (MSum a -> MSum b -> MSum c)+liftMS2 _ Nothing Nothing = Nothing+liftMS2 h ma mb = Just (Sum (h (fromMS ma) (fromMS mb)))++liftMS3 :: (AdditiveGroup a, AdditiveGroup b, AdditiveGroup c) =>+           (a -> b -> c -> d) ->+           (MSum a -> MSum b -> MSum c -> MSum d)+liftMS3 _ Nothing Nothing Nothing = Nothing+liftMS3 h ma mb mc = Just (Sum (h (fromMS ma) (fromMS mb) (fromMS mc)))++fromMS :: AdditiveGroup u => MSum u -> u+fromMS Nothing        = zeroV+fromMS (Just (Sum u)) = u+++-- | Apply a linear function to each element of a linear map.+-- @liftL f l == linear f *.* l@, but works more efficiently.+liftL :: (Functor f, AdditiveGroup (f a)) =>+         (a -> b) -> MSum (f a) -> MSum (f b)+liftL = liftMS . fmap++-- | Apply a linear binary function (not to be confused with a bilinear+-- function) to each element of a linear map.+liftL2 :: (Applicative f, AdditiveGroup (f a), AdditiveGroup (f b)) =>+          (a -> b -> c)+       -> (MSum (f a) -> MSum (f b) -> MSum (f c))+liftL2 = liftMS2 . liftA2++-- | Apply a linear ternary function (not to be confused with a trilinear+-- function) to each element of a linear map.+liftL3 :: ( Applicative f+          , AdditiveGroup (f a), AdditiveGroup (f b), AdditiveGroup (f c)) =>+          (a -> b -> c -> d)+       -> (MSum (f a) -> MSum (f b) -> MSum (f c) -> MSum (f d))+liftL3 = liftMS3 . liftA3
src/Data/Maclaurin.hs view
@@ -30,17 +30,18 @@  module Data.Maclaurin   (-    (:>), powVal, derivative+    (:>)(D), powVal, derivative, derivAtBasis  -- maybe not D   , (:~>), pureD   , fmapD, (<$>>){-, (<*>>)-}, liftD2, liftD3   , idD, fstD, sndD   , linearD, distrib   -- , (@.)   , (>-<)+  -- * Misc+  , pairD, unpairD, tripleD, untripleD   )      where -import Control.Applicative  import Data.VectorSpace import Data.NumInstances ()@@ -73,35 +74,38 @@  infixl 4 <$>> -- | Map a /linear/ function over a derivative tower.-fmapD, (<$>>) :: (HasTrie (Basis a)) =>+fmapD, (<$>>) :: (HasBasis a, HasTrie (Basis a), AdditiveGroup b) =>                  (b -> c) -> (a :> b) -> (a :> c)-fmapD f (D b0 b') = D (f b0) ((fmap.fmapD) f b')+fmapD f = lf+ where+   lf (D b0 b') = D (f b0) (liftL lf b')  (<$>>) = fmapD  -- | Apply a /linear/ binary function over derivative towers.-liftD2 :: HasTrie (Basis a) =>+liftD2 :: (HasBasis a, HasTrie (Basis a), AdditiveGroup b, AdditiveGroup c) =>           (b -> c -> d) -> (a :> b) -> (a :> c) -> (a :> d)-liftD2 f (D b0 b') (D c0 c') = D (f b0 c0) (liftA2 (liftD2 f) b' c')+liftD2 f = lf+ where+   lf (D b0 b') (D c0 c') = D (f b0 c0) (liftL2 lf b' c')   -- | Apply a /linear/ ternary function over derivative towers.-liftD3 :: HasTrie (Basis a) =>+liftD3 :: (HasBasis a, HasTrie (Basis a)+          , AdditiveGroup b, AdditiveGroup c, AdditiveGroup d) =>           (b -> c -> d -> e)        -> (a :> b) -> (a :> c) -> (a :> d) -> (a :> e)-liftD3 f (D b0 b') (D c0 c') (D d0 d') = D (f b0 c0 d0) (liftA3 (liftD3 f) b' c' d')+liftD3 f = lf+ where+   lf (D b0 b') (D c0 c') (D d0 d') =+     D (f b0 c0 d0) (liftL3 lf b' c' d') --- TODO: Define liftD2, liftD3 in terms of (<*>>) Compare generated code--- for speed. --- infixl 4 <*>>--- -- | Like '(<*>)' for derivative towers.--- (<*>>) :: (HasTrie (Basis a)) =>---           (a :> (b -> c)) -> (a :> b) -> (a :> c)--- D f0 f' <*>> D x0 x' = D (f0 x0) (liftA2 (<*>>) f' x')+-- TODO: Can liftD2 and liftD3 be defined in terms of a (<*>>) similar to+-- (<*>)?  If so, can the speed be as good?  -- liftD2 f a b = (f <$>> a) <*>> b-+--  -- liftD3 f a b c = liftD2 f a b <*>> c  @@ -163,25 +167,17 @@  -- | Derivative tower for applying a binary function that distributes over -- addition, such as multiplication.  A bit weaker assumption than--- bilinearity.+-- bilinearity.  Is bilinearity necessary for correctness here? distrib :: forall a b c u.-           (HasBasis a, HasTrie (Basis a), AdditiveGroup u) =>+           ( HasBasis a, HasTrie (Basis a)+           , AdditiveGroup b, AdditiveGroup c, AdditiveGroup u) =>            (b -> c -> u) -> (a :> b) -> (a :> c) -> (a :> u) --- distrib op u@(D u0 u') v@(D v0 v') =---   D (u0 `op` v0) (trie (\ e -> distrib op u (v' `untrie` e) ^+^---                                distrib op (u' `untrie` e) v))--distrib op u@(D u0 u') v@(D v0 v') = D (u0 `op` v0) (inTrie2 comb u' v')+distrib op = (#)  where-   -- comb :: (Basis a -> a :> b) -> (Basis a -> a :> c) -> (Basis a -> a :> u)-   comb uf vf (e :: Basis a) =-     distrib op u (vf e) ^+^ distrib op (uf e) v----   comb uf vf = distrib op u . vf ^+^ flip (distrib op) v . uf---- TODO: Look for a formulation of distrib that eliminates the explicit--- conversion between functions and tries.  Maybe something with trie addition.+   u@(D u0 u') # v@(D v0 v') =+     D (u0 `op` v0) ( liftMS (inTrie ((# v) .)) u' ^+^+                      liftMS (inTrie ((u #) .)) v' )   -- TODO: I think this distrib is exponential in increasing degree.  Switch@@ -189,16 +185,23 @@ -- McIlroy.  -instance Show b => Show (a :> b) where show    = noOv "show"+-- instance Show b => Show (a :> b) where show    = noOv "show"++instance Show b => Show (a :> b) where+  show (D b0 _) = "D " ++ show b0  ++ " ..."+ instance Eq   b => Eq   (a :> b) where (==)    = noOv "(==)" instance Ord  b => Ord  (a :> b) where compare = noOv "compare"  instance (HasBasis a, HasTrie (Basis a), AdditiveGroup u) => AdditiveGroup (a :> u) where   zeroV   = pureD  zeroV    -- or dZero   negateV = fmapD  negateV-  (^+^)   = liftD2 (^+^)+  D a0 a' ^+^ D b0 b' = D (a0 ^+^ b0) (a' ^+^ b')+  -- Less efficient: adds zero+  -- (^+^)   = liftD2 (^+^) -instance (HasBasis a, HasTrie (Basis a), VectorSpace u)+instance ( HasBasis a, HasTrie (Basis a)+         , VectorSpace u, AdditiveGroup (Scalar u) )       => VectorSpace (a :> u) where   type Scalar (a :> u) = (a :> Scalar u)   (*^) = distrib (*^)                     @@ -220,10 +223,11 @@ infix  0 >-<  -- | Specialized chain rule.  See also '(\@.)'-(>-<) :: (HasBasis a, HasTrie (Basis a), VectorSpace u) =>+(>-<) :: ( HasBasis a, HasTrie (Basis a), VectorSpace u+         , AdditiveGroup (Scalar u)) =>          (u -> u) -> ((a :> u) -> (a :> Scalar u))       -> (a :> u) -> (a :> u)-f >-< f' = \ u@(D u0 u') -> D (f u0) (f' u *^ u')+f >-< f' = \ u@(D u0 u') -> D (f u0) (liftMS (f' u *^) u')   -- TODO: express '(>-<)' in terms of '(@.)'.  If I can't, then understand why not.@@ -233,9 +237,8 @@          )       => Num (a:>s) where   fromInteger = pureD . fromInteger-  (+) = liftD2  (+)-  (-) = liftD2  (-)-  (*) = distrib (*)+  (+)    = (^+^)+  (*)    = distrib (*)   negate = negate >-< -1   abs    = abs    >-< signum   signum = signum >-< 0  -- derivative wrong at zero@@ -266,3 +269,42 @@   asinh = asinh >-< recip (sqrt (1+sqr))   acosh = acosh >-< recip (- sqrt (sqr-1))   atanh = atanh >-< recip (1-sqr)+++-- | Sample the derivative at a basis element.  Optimized for partial+-- application to save work for non-scalar derivatives.+derivAtBasis :: (HasTrie (Basis a), HasBasis a, AdditiveGroup b) =>+                (a :> b) -> (Basis a -> (a :> b))+derivAtBasis f = atBasis (derivative f)+++---- Misc++pairD :: ( HasBasis a, HasTrie (Basis a)+         , VectorSpace b, VectorSpace c+         , Scalar b ~ Scalar c+         ) => (a:>b,a:>c) -> a:>(b,c)++pairD (u,v) = liftD2 (,) u v++unpairD :: ( HasBasis a, HasTrie (Basis a)+           , VectorSpace a, VectorSpace b, VectorSpace c+           , Scalar b ~ Scalar c+           ) => (a :> (b,c)) -> (a:>b, a:>c)+unpairD d = (fst <$>> d, snd <$>> d)+++tripleD :: ( HasBasis a, HasTrie (Basis a)+           , VectorSpace b, VectorSpace c, VectorSpace d+           , Scalar b ~ Scalar c, Scalar c ~ Scalar d+           ) => (a:>b,a:>c,a:>d) -> a:>(b,c,d)+tripleD (u,v,w) = liftD3 (,,) u v w++untripleD :: ( HasBasis a, HasTrie (Basis a)+             , VectorSpace a, VectorSpace b, VectorSpace c, VectorSpace d+             , Scalar b ~ Scalar c, Scalar c ~ Scalar d+             ) =>+             (a :> (b,c,d)) -> (a:>b, a:>c, a:>d)+untripleD d =+  ((\ (a,_,_) -> a) <$>> d, (\ (_,b,_) -> b) <$>> d, (\ (_,_,c) -> c) <$>> d)+
src/Data/VectorSpace.hs view
@@ -37,12 +37,11 @@  infixr 7 *^ --- | Vector space @v@ over a scalar field @s@.  Extends 'AdditiveGroup'--- with scalar multiplication.+-- | Vector space @v@. class AdditiveGroup v => VectorSpace v where   type Scalar v :: *   -- | Scale a vector-  (*^)  :: Scalar v -> v -> v+  (*^) :: Scalar v -> v -> v  infixr 7 <.> @@ -134,6 +133,22 @@          , AdditiveGroup s )     => InnerSpace (u,v,w) where   (u,v,w) <.> (u',v',w') = u<.>u' ^+^ v<.>v' ^+^ w<.>w'++instance ( VectorSpace u, s ~ Scalar u+         , VectorSpace v, s ~ Scalar v+         , VectorSpace w, s ~ Scalar w+         , VectorSpace x, s ~ Scalar x )+    => VectorSpace (u,v,w,x) where+  type Scalar (u,v,w,x) = Scalar u+  s *^ (u,v,w,x) = (s*^u,s*^v,s*^w,s*^x)++instance ( InnerSpace u, s ~ Scalar u+         , InnerSpace v, s ~ Scalar v+         , InnerSpace w, s ~ Scalar w+         , InnerSpace x, s ~ Scalar x+         , AdditiveGroup s )+    => InnerSpace (u,v,w,x) where+  (u,v,w,x) <.> (u',v',w',x') = u<.>u' ^+^ v<.>v' ^+^ w<.>w' ^+^ x<.>x'   -- Standard instances for a functor applied to a vector space.
vector-space.cabal view
@@ -1,5 +1,5 @@ Name:                vector-space-Version:             0.5.3+Version:             0.5.6 Cabal-Version:       >= 1.2 Synopsis:            Vector & affine spaces, linear maps, and derivatives (requires ghc 6.9 or better) Category:            math