vector-space 0.4.1 → 0.5

raw patch · 11 files changed

+230/−509 lines, 11 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• src/Data/ABasis.hs +0/−135
• src/Data/ALinearMap.hs +0/−44
• src/Data/AVectorSpace.hs +0/−147
• src/Data/AffineSpace.hs +27/−14
• src/Data/Basis.hs +44/−36
• src/Data/Cross.hs +26/−21
• src/Data/Horner.hs +2/−2
• src/Data/LinearMap.hs +11/−10
• src/Data/Maclaurin.hs +49/−50
• src/Data/VectorSpace.hs +66/−37
• vector-space.cabal +5/−13

@@ -1,135 +0,0 @@--- WARNING: this module depends on type families working fairly well, and--- requires ghc version at least 6.9.  I didn't find a way to specify that--- dependency in the .cabal.--- -{-# LANGUAGE TypeOperators, TypeFamilies, UndecidableInstances-  , FlexibleInstances, MultiParamTypeClasses-  #-}-{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}-------------------------------------------------------------------------- |--- Module      :  Data.ABasis--- Copyright   :  (c) Conal Elliott 2008--- License     :  BSD3--- --- Maintainer  :  conal@conal.net--- Stability   :  experimental--- --- Basis of a vector space, as an associated type--- This module requires ghc-6.10 or later-------------------------------------------------------------------------module Data.ABasis (HasBasis(..), linearCombo, recompose) where---- import Control.Applicative ((<$>))-import Control.Arrow (first)-import Data.Either--import Data.AVectorSpace--class VectorSpace v => HasBasis v where-  -- | Representation of the canonical basis for @v@-  type Basis v :: *-  -- | Interpret basis rep as a vector-  basisValue   :: Basis v -> v-  -- | Extract coordinates-  decompose    :: v -> [(Basis v, Scalar v)]-  -- | Experimental version.  More elegant definitions, and friendly to-  -- infinite-dimensional vector spaces.-  decompose'   :: v -> (Basis v -> Scalar v)---- Defining property: recompose . decompose == id---- | Linear combination-linearCombo :: VectorSpace v => [(v,Scalar v)] -> v-linearCombo ps = sumV [s *^ v | (v,s) <- ps]---- Turn a basis decomposition back into a vector.-recompose :: HasBasis v => [(Basis v, Scalar v)] -> v-recompose = linearCombo . fmap (first basisValue)---- recompose ps = linearCombo (first basisValue <$> ps)----- I don't know how to define--- ---   recompose' :: HasBasis v => (Basis v -> Scalar v) -> v--- --- However, I don't seem to use recompose anywhere.--- I don't even use basisValue or decompose.--instance HasBasis Float where-  type Basis Float = ()-  basisValue ()    = 1-  decompose s      = [((),s)]-  decompose' s     = const s--instance HasBasis Double where-  type Basis Double = ()-  basisValue ()     = 1-  decompose s       = [((),s)]-  decompose' s      = const s--instance ( HasBasis u, s ~ Scalar u-         , HasBasis v, s ~ Scalar v )-      => HasBasis (u,v) where-  type Basis (u,v)     = Basis u `Either` Basis v-  basisValue (Left  a) = (basisValue a, zeroV)-  basisValue (Right b) = (zeroV, basisValue b)-  decompose  (u,v)     = decomp2 Left u ++ decomp2 Right v-  decompose' (u,v)     = decompose' u `either` decompose' v---decomp2 :: HasBasis w => (Basis w -> b) -> w -> [(b, Scalar w)]-decomp2 inject = fmap (first inject) . decompose--instance ( HasBasis u, s ~ Scalar u-         , HasBasis v, s ~ Scalar v-         , HasBasis w, s ~ Scalar w )-      => HasBasis (u,v,w) where-  type Basis (u,v,w) = Basis (u,(v,w))-  basisValue         = unnest3 . basisValue-  decompose          = decompose  . nest3-  decompose'         = decompose' . nest3--unnest3 :: (a,(b,c)) -> (a,b,c)-unnest3 (a,(b,c)) = (a,b,c)--nest3 :: (a,b,c) -> (a,(b,c))-nest3 (a,b,c) = (a,(b,c))---instance (Eq a, HasBasis u) => HasBasis (a -> u) where-  type Basis (a -> u) = (a, Basis u)-  basisValue (a,b) = f-    where f a' | a == a'   = bv-               | otherwise = zeroV-          bv = basisValue b-  decompose = error "decompose: not defined on functions"-  decompose' g (a,b) = decompose' (g a) b----- Simpler but less efficient:--- ---   basisValue (a,b) a' | a == a'   = basisValue b---                       | otherwise = zeroV---- Just for pointless perversion points:--- ---   decompose' g = uncurry (\ a b -> decompose' (g a) b)---   decompose' g = uncurry (\ a -> decompose' (g a))---   decompose' g = uncurry (decompose' . g)---   decompose' = uncurry . fmap decompose'---   decompose' = (fmap uncurry) (fmap decompose')---{------- Testing--t1 = basisValue () :: Float-t2 = basisValue () :: Double-t3 = basisValue (Right ()) :: (Float,Double)-t4 = basisValue (Right (Left ())) :: (Float,Double,Float)---}

@@ -1,44 +0,0 @@-{-# LANGUAGE TypeOperators, FlexibleContexts, TypeFamilies #-}-{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}--- {-# OPTIONS_GHC -funbox-strict-fields #-}--- {-# OPTIONS_GHC -ddump-simpl-stats -ddump-simpl #-}-------------------------------------------------------------------------- |--- Module      :  Data.ALinearMap--- Copyright   :  (c) Conal Elliott 2008--- License     :  BSD3--- --- Maintainer  :  conal@conal.net--- Stability   :  experimental--- --- Linear maps--- This version uses ABasis, which requires ghc-6.10 or later.-------------------------------------------------------------------------module Data.ALinearMap-  ( (:-*) , linear, lapply-  ) where--import Control.Arrow (first)-import Data.Function--import Data.MemoTrie-import Data.AVectorSpace-import Data.ABasis----- | Linear map, represented as a memo-trie from basis to values.-type u :-* v = Basis u :->: v---- TODO: Use a regular function from @Basis u@, but memoize it.---- | Function (assumed linear) as linear map.-linear :: (VectorSpace u, VectorSpace v, HasBasis u, HasTrie (Basis u)) =>-          (u -> v) -> (u :-* v)-linear f = trie (f . basisValue)---- | Apply a linear map to a vector.-lapply :: ( VectorSpace u, VectorSpace v, Scalar u ~ Scalar v-          , HasBasis u, HasTrie (Basis u) ) =>-          (u :-* v) -> (u -> v)-lapply lm = linearCombo . fmap (first (untrie lm)) . decompose

@@ -1,147 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies -           , TypeOperators, FlexibleInstances, UndecidableInstances-           , TypeFamilies, FlexibleContexts- #-}-------------------------------------------------------------------------- |--- Module      :   Data.AVectorSpace--- Copyright   :  (c) Conal Elliott and Andy J Gill 2008--- License     :  BSD3--- --- Maintainer  :  conal@conal.net, andygill@ku.edu--- Stability   :  experimental--- --- Vector spaces--- --- This version uses associated types instead of fundeps and--- requires ghc-6.10 or later--------------------------------------------------------------------------- NB: I'm attempting to replace fundeps with associated types.  See--- NewVectorSpace.hs.  Ran into trouble with type equality constraints not--- getting propagated.  Manuel Ch is looking into it.--- --- Blocking bug: http://hackage.haskell.org/trac/ghc/ticket/2448--module Data.AVectorSpace-  ( module Data.AdditiveGroup-  , VectorSpace(..), (^/), (^*)-  , InnerSpace(..)-  , lerp, magnitudeSq, magnitude, normalized-  ) where--import Data.Complex hiding (magnitude)--import Data.AdditiveGroup-import Data.MemoTrie--infixr 7 *^---- | Vector space @v@ over a scalar field @s@.  Extends 'AdditiveGroup'--- with scalar multiplication.-class AdditiveGroup v => VectorSpace v where-  type Scalar v :: *-  -- | Scale a vector-  (*^)  :: Scalar v -> v -> v--infixr 7 <.>---- | Adds inner (dot) products.-class VectorSpace v => InnerSpace v where-  -- | Inner/dot product-  (<.>) :: v -> v -> Scalar v--infixr 7 ^/-infixl 7 ^*---- | Vector divided by scalar-(^/) :: (VectorSpace v, s ~ Scalar v, Fractional s) => v -> s -> v-v ^/ s = (1/s) *^ v---- | Vector multiplied by scalar-(^*) :: (VectorSpace v, s ~ Scalar v) => v -> s -> v-(^*) = flip (*^)---- | Linear interpolation between @a@ (when @t==0@) and @b@ (when @t==1@).-lerp :: (VectorSpace v, s ~ Scalar v, Num s) => v -> v -> s -> v-lerp a b t = (1-t)*^a ^+^ t*^b---- | Square of the length of a vector.  Sometimes useful for efficiency.--- See also 'magnitude'.-magnitudeSq :: (InnerSpace v, s ~ Scalar v) => v -> s-magnitudeSq v = v <.> v---- | Length of a vector.   See also 'magnitudeSq'.-magnitude :: (InnerSpace v, s ~ Scalar v, Floating s) =>  v -> s-magnitude = sqrt . magnitudeSq---- | Vector in same direction as given one but with length of one.  If--- given the zero vector, then return it.-normalized :: (InnerSpace v, s ~ Scalar v, Floating s) =>  v -> v-normalized v = v ^/ magnitude v--instance VectorSpace Double where-  type Scalar Double = Double-  (*^) = (*)-instance InnerSpace  Double where (<.>) = (*)--instance VectorSpace Float  where-  type Scalar Float = Float-  (*^)  = (*)-instance InnerSpace  Float  where (<.>) = (*)--instance (RealFloat v, VectorSpace v) => VectorSpace (Complex v) where-  type Scalar (Complex v) = Scalar v-  s*^(u :+ v) = s*^u :+ s*^v--instance (RealFloat v, InnerSpace v, s ~ Scalar v, AdditiveGroup s)-     => InnerSpace (Complex v) where-  (u :+ v) <.> (u' :+ v') = (u <.> u') ^+^ (v <.> v')---- Hm.  The 'RealFloat' constraint is unfortunate here.  It's due to a--- questionable decision to place 'RealFloat' into the definition of the--- 'Complex' /type/, rather than in functions and instances as needed.---- instance (VectorSpace u,VectorSpace v, s ~ Scalar u, s ~ Scalar v)---          => VectorSpace (u,v) where---   type Scalar (u,v) = Scalar u---   s *^ (u,v) = (s*^u,s*^v)--instance ( VectorSpace u, s ~ Scalar u-         , VectorSpace v, s ~ Scalar v )-      => VectorSpace (u,v) where-  type Scalar (u,v) = Scalar u-  s *^ (u,v) = (s*^u,s*^v)--instance ( InnerSpace u, s ~ Scalar u-         , InnerSpace v, s ~ Scalar v-         , AdditiveGroup (Scalar v) )-    => InnerSpace (u,v) where-  (u,v) <.> (u',v') = (u <.> u') ^+^ (v <.> v')--instance ( VectorSpace u, s ~ Scalar u-         , VectorSpace v, s ~ Scalar v-         , VectorSpace w, s ~ Scalar w )-    => VectorSpace (u,v,w) where-  type Scalar (u,v,w) = Scalar u-  s *^ (u,v,w) = (s*^u,s*^v,s*^w)--instance ( InnerSpace u, s ~ Scalar u-         , InnerSpace v, s ~ Scalar v-         , InnerSpace w, s ~ Scalar w-         , AdditiveGroup s )-    => InnerSpace (u,v,w) where-  (u,v,w) <.> (u',v',w') = u<.>u' ^+^ v<.>v' ^+^ w<.>w'----- Standard instance for an applicative functor applied to a vector space.-instance VectorSpace v => VectorSpace (a -> v) where-  type Scalar (a -> v) = Scalar v-  (*^) s = fmap (s *^)---- No 'InnerSpace' instance for @(a -> v)@.--instance (HasTrie a, VectorSpace v)-         => VectorSpace (a :->: v) where-  type Scalar (a :->: v) = Scalar v-  (*^) s = fmap ((*^) s)

@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, TypeFamilies #-} ---------------------------------------------------------------------- -- | -- Module      :  Data.AffineSpace@@ -20,11 +20,16 @@  infix 4 .+^, .-^, .-. -class VectorSpace v s => AffineSpace p v s | p -> v s where+-- TODO: Convert AffineSpace from fundep to associated type, and eliminate+-- FunctionalDependencies above.++class VectorSpace (AVector p) => AffineSpace p where+  -- | Associated vector space+  type AVector p   -- | Subtract points-  (.-.)  :: p -> p -> v+  (.-.)  :: p -> p -> AVector p   -- | Point plus vector-  (.+^)  :: p -> v -> p+  (.+^)  :: p -> AVector p -> p  -- TODO: consider replacing p and v with a type constructor argument: -- @@ -36,27 +41,35 @@ -- doubles & floats.  -- | Point minus vector-(.-^) :: (Num s, AffineSpace p v s) => p -> v -> p+(.-^) :: (AffineSpace p) => p -> AVector p -> p p .-^ v = p .+^ negateV v  -- | Square of the distance between two points.  Sometimes useful for -- efficiency.  See also 'distance'.-distanceSq :: (AffineSpace p v s, InnerSpace v s) => p -> p -> s+distanceSq :: (AffineSpace p, v ~ AVector p, InnerSpace v) =>+              p -> p -> Scalar v distanceSq = (fmap.fmap) magnitudeSq (.-.)  -- | Distance between two points.  See also 'distanceSq'.-distance :: (Floating s, AffineSpace p v s, InnerSpace v s) => p -> p -> s+distance :: (AffineSpace p, v ~ AVector p, InnerSpace v+            , s ~ Scalar v, Floating (Scalar v))+         => p -> p -> s distance = (fmap.fmap) sqrt distanceSq  -- | Affine linear interpolation.  Varies from @p@ to @p'@ as @s@ varies -- from 0 to 1.  See also 'lerp' (on vector spaces).-alerp :: AffineSpace p v s => p -> p -> s -> p+alerp :: AffineSpace p => p -> p -> Scalar (AVector p) -> p alerp p p' s = p .+^ (s *^ (p' .-. p)) -instance  AffineSpace Double Double Double where-  (.-.)  =  (-)-  (.+^)  =  (+)+instance  AffineSpace Double where+  type AVector Double = Double+  (.-.) =  (-)+  (.+^) =  (+) -instance  AffineSpace Float Float Float where-  (.-.)  =  (-)-  (.+^)  =  (+)+instance  AffineSpace Float where+  type AVector Float = Float+  (.-.) =  (-)+  (.+^) =  (+)++-- TODO: pairs & triples.  Functions?+

@@ -15,75 +15,81 @@ -- Maintainer  :  conal@conal.net -- Stability   :  experimental -- --- Basis of a vector space, as an associated type.---  This version works with @Data.VectorSpace@, thus avoiding a bug in---  ghc-6.9..+-- Basis of a vector space, as an associated type+-- This module requires ghc-6.10 or later ----------------------------------------------------------------------  module Data.Basis (HasBasis(..), linearCombo, recompose) where +-- import Control.Applicative ((<$>)) import Control.Arrow (first) import Data.Either  import Data.VectorSpace -class VectorSpace v s => HasBasis v s where+class VectorSpace v => HasBasis v where   -- | Representation of the canonical basis for @v@   type Basis v :: *   -- | Interpret basis rep as a vector   basisValue   :: Basis v -> v   -- | Extract coordinates-  decompose    :: v -> [(Basis v, s)]+  decompose    :: v -> [(Basis v, Scalar v)]   -- | Experimental version.  More elegant definitions, and friendly to   -- infinite-dimensional vector spaces.-  decompose'   :: v -> (Basis v -> s)---- TODO: Switch from fundep to associated type.  Eliminate the second type--- parameter in VectorSpace and HasBasis.--- Blocking bug: http://hackage.haskell.org/trac/ghc/ticket/2448--- Fixed in ghc 6.10.+  decompose'   :: v -> (Basis v -> Scalar v)  -- Defining property: recompose . decompose == id  -- | Linear combination-linearCombo :: VectorSpace v s => [(v,s)] -> v+linearCombo :: VectorSpace v => [(v,Scalar v)] -> v linearCombo ps = sumV [s *^ v | (v,s) <- ps] --- | Turn a basis decomposition back into a vector.-recompose :: HasBasis v s => [(Basis v, s)] -> v+-- Turn a basis decomposition back into a vector.+recompose :: HasBasis v => [(Basis v, Scalar v)] -> v recompose = linearCombo . fmap (first basisValue)  -- recompose ps = linearCombo (first basisValue <$> ps)  --- recompose = sumV . fmap (\ (b,s) -> s *^ basisValue b)+-- I don't know how to define+-- +--   recompose' :: HasBasis v => (Basis v -> Scalar v) -> v+-- +-- However, I don't seem to use recompose anywhere.+-- I don't even use basisValue or decompose. -instance HasBasis Float Float where+instance HasBasis Float where   type Basis Float = ()   basisValue ()    = 1   decompose s      = [((),s)]   decompose' s     = const s -instance HasBasis Double Double where+instance HasBasis Double where   type Basis Double = ()   basisValue ()     = 1   decompose s       = [((),s)]-  decompose' s     = const s+  decompose' s      = const s -instance (HasBasis u s, HasBasis v s) => HasBasis (u,v) s where+instance ( HasBasis u, s ~ Scalar u+         , HasBasis v, s ~ Scalar v )+      => HasBasis (u,v) where   type Basis (u,v)     = Basis u `Either` Basis v   basisValue (Left  a) = (basisValue a, zeroV)   basisValue (Right b) = (zeroV, basisValue b)   decompose  (u,v)     = decomp2 Left u ++ decomp2 Right v   decompose' (u,v)     = decompose' u `either` decompose' v -decomp2 :: HasBasis w s => (Basis w -> b) -> w -> [(b, s)]++decomp2 :: HasBasis w => (Basis w -> b) -> w -> [(b, Scalar w)] decomp2 inject = fmap (first inject) . decompose -instance (HasBasis u s, HasBasis v s, HasBasis w s) => HasBasis (u,v,w) s where+instance ( HasBasis u, s ~ Scalar u+         , HasBasis v, s ~ Scalar v+         , HasBasis w, s ~ Scalar w )+      => HasBasis (u,v,w) where   type Basis (u,v,w) = Basis (u,(v,w))   basisValue         = unnest3 . basisValue-  decompose          = decompose . nest3+  decompose          = decompose  . nest3   decompose'         = decompose' . nest3  unnest3 :: (a,(b,c)) -> (a,b,c)@@ -92,20 +98,8 @@ nest3 :: (a,b,c) -> (a,(b,c)) nest3 (a,b,c) = (a,(b,c)) --- Without UndecidableInstances:--- ---     Application is no smaller than the instance head---       in the type family application: Basis (u, (v, w))---     (Use -fallow-undecidable-instances to permit this)---     In the type synonym instance declaration for `Basis'---     In the instance declaration for `HasBasis (u, v, w)'--- --- A work-around:--- ---     type Basis (u,v,w) = Basis u `Either` Basis (v,w) --instance (Eq a, HasBasis u s) => HasBasis (a -> u) s where+instance (Eq a, HasBasis u) => HasBasis (a -> u) where   type Basis (a -> u) = (a, Basis u)   basisValue (a,b) = f     where f a' | a == a'   = bv@@ -114,6 +108,21 @@   decompose = error "decompose: not defined on functions"   decompose' g (a,b) = decompose' (g a) b ++-- Simpler but less efficient:+-- +--   basisValue (a,b) a' | a == a'   = basisValue b+--                       | otherwise = zeroV++-- Just for pointless perversion points:+-- +--   decompose' g = uncurry (\ a b -> decompose' (g a) b)+--   decompose' g = uncurry (\ a -> decompose' (g a))+--   decompose' g = uncurry (decompose' . g)+--   decompose' = uncurry . fmap decompose'+--   decompose' = (fmap uncurry) (fmap decompose')++ {-  ---- Testing@@ -124,4 +133,3 @@ t4 = basisValue (Right (Left ())) :: (Float,Double,Float)  -}-

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeOperators, UndecidableInstances+{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeOperators            , TypeFamilies, TypeSynonymInstances   #-} {-# OPTIONS_GHC -Wall #-}@@ -33,7 +33,7 @@ class HasNormal v where normalVec :: v -> v  -- | Normalized normal vector.  See also 'cross'.-normal :: (HasNormal v, InnerSpace v s, Floating s) => v -> v+normal :: (HasNormal v, InnerSpace v, Floating (Scalar v)) => v -> v normal = normalized . normalVec  -- | Singleton@@ -51,20 +51,17 @@ instance AdditiveGroup u => HasCross2 (u,u) where   cross2 (x,y) = (negateV y,x)  -- or @(y,-x)@? --- "Variable occurs more often in a constraint than in the instance--- head".  Hence UndecidableInstances.--instance ( HasBasis a s, HasTrie (Basis a)-         , VectorSpace v s, HasCross2 v) => HasCross2 (a:>v) where+instance ( HasBasis a, HasTrie (Basis a)+         , VectorSpace v, HasCross2 v) => HasCross2 (a:>v) where   -- 2d cross-product is linear   cross2 = fmapD cross2 -instance (HasBasis s s, HasTrie (Basis s), Basis s ~ ()) =>+instance (HasBasis s, HasTrie (Basis s), Basis s ~ ()) =>          HasNormal (One s :> Two s) where   normalVec v = cross2 (derivative v `untrie` ()) -instance ( Num s, VectorSpace s s-         , HasBasis s s, HasTrie (Basis s), Basis s ~ ())+instance ( Num s, VectorSpace s+         , HasBasis s, HasTrie (Basis s), Basis s ~ ())     => HasNormal (Two (One s :> s)) where   normalVec = unpairD . normalVec . pairD @@ -81,17 +78,17 @@  -- TODO: Eliminate the 'Num' constraint by using 'VectorSpace' operations. -instance (HasBasis a s, HasTrie (Basis a), VectorSpace v s, HasCross3 v) => HasCross3 (a:>v) where+instance (HasBasis a, HasTrie (Basis a), VectorSpace v, HasCross3 v) => HasCross3 (a:>v) where   -- 3D cross-product is bilinear (curried linear)   cross3 = distrib cross3 -instance (Num s, HasTrie (Basis (s, s)), HasBasis s s, Basis s ~ ()) =>+instance (Num s, HasTrie (Basis (s, s)), HasBasis s, Basis s ~ ()) =>          HasNormal (Two s :> Three s) where   normalVec v = d (Left ()) `cross3` d (Right ())    where      d = untrie (derivative v) -instance ( Num s, VectorSpace s s, HasBasis s s, HasTrie (Basis s)+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@@ -99,20 +96,28 @@  ---- Could go elsewhere -pairD :: (HasBasis a s, HasTrie (Basis a), VectorSpace b s, VectorSpace c s) =>-         (a:>b,a:>c) -> a:>(b,c)+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 s, HasTrie (Basis a), VectorSpace b s, VectorSpace c s, VectorSpace d s) =>-           (a:>b,a:>c,a:>d) -> a:>(b,c,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 -unpairD :: (HasBasis a s, HasTrie (Basis a), VectorSpace a s, VectorSpace b s, VectorSpace c s) =>-           (a :> (b,c)) -> (a:>b, a:>c)+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 s, HasTrie (Basis a) , VectorSpace a s, VectorSpace b s-             , VectorSpace c s, VectorSpace d s) =>+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)

@@ -1,5 +1,5 @@-{-# LANGUAGE TypeOperators, MultiParamTypeClasses, UndecidableInstances-           , TypeSynonymInstances, FlexibleInstances, FunctionalDependencies+{-# LANGUAGE TypeOperators, MultiParamTypeClasses+           , TypeSynonymInstances, FlexibleInstances   #-} {-# OPTIONS_GHC -Wall #-} ----------------------------------------------------------------------

@@ -1,6 +1,6 @@-{-# LANGUAGE TypeOperators, FlexibleContexts #-}+{-# LANGUAGE TypeOperators, FlexibleContexts, TypeFamilies #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-}--- {-# OPTIONS_GHC -fglasgow-exts -funbox-strict-fields #-}+-- {-# OPTIONS_GHC -funbox-strict-fields #-} -- {-# OPTIONS_GHC -ddump-simpl-stats -ddump-simpl #-} ---------------------------------------------------------------------- -- |@@ -12,6 +12,7 @@ -- Stability   :  experimental --  -- Linear maps+-- This version uses ABasis, which requires ghc-6.10 or later. ----------------------------------------------------------------------  module Data.LinearMap@@ -21,23 +22,23 @@ import Control.Arrow (first) import Data.Function -import Data.VectorSpace import Data.MemoTrie+import Data.VectorSpace import Data.Basis --- | Linear map, represented a as a memo function from basis to values.++-- | Linear map, represented as a memo-trie from basis to values. type u :-* v = Basis u :->: v +-- TODO: Use a regular function from @Basis u@, but memoize it.+ -- | Function (assumed linear) as linear map.-linear :: (VectorSpace u s, VectorSpace v s', HasBasis u s, HasTrie (Basis u)) =>+linear :: (VectorSpace u, VectorSpace v, HasBasis u, HasTrie (Basis u)) =>           (u -> v) -> (u :-* v) linear f = trie (f . basisValue)  -- | Apply a linear map to a vector.-lapply :: (VectorSpace u s, VectorSpace v s, HasBasis u s, HasTrie (Basis u)) =>+lapply :: ( VectorSpace u, VectorSpace v, Scalar u ~ Scalar v+          , HasBasis u, HasTrie (Basis u) ) =>           (u :-* v) -> (u -> v) lapply lm = linearCombo . fmap (first (untrie lm)) . decompose----- TODO: unfst, unsnd, pair, unpair-

@@ -1,6 +1,6 @@ {-# LANGUAGE TypeOperators, MultiParamTypeClasses, UndecidableInstances-           , TypeSynonymInstances, FlexibleInstances, FunctionalDependencies-           , FlexibleContexts+           , TypeSynonymInstances, FlexibleInstances+           , FlexibleContexts, TypeFamilies            , ScopedTypeVariables   #-} @@ -30,7 +30,7 @@  module Data.Maclaurin   (-    (:>), powVal, derivative --, derivativeAt+    (:>), powVal, derivative   , (:~>), dZero, pureD   , fmapD, (<$>>){-, (<*>>)-}, liftD2, liftD3   , idD, fstD, sndD@@ -56,35 +56,22 @@ -- | Infinitely differentiable functions type a :~> b = a -> (a:>b) --- -- | Sampled derivative.  For avoiding an awkward typing problem related--- -- to the two required 'VectorSpace' instances.--- derivativeAt :: (VectorSpace b s) =>---                 (a :> b) -> a -> (a :> b)--- derivativeAt d = lapply (derivative d)---- The crucial point here is for 'lapply' to be interpreted with respect to--- the 'VectorSpace' instance in this module, not Mac.---- The argument order for 'derivativeAt' allows partial evaluation, which--- is useful in power series representations for which 'derivative' is not--- free (Horner).- -- Handy for missing methods. noOv :: String -> a noOv op = error (op ++ ": not defined on a :> b")  -- | Derivative tower full of 'zeroV'.-dZero :: (AdditiveGroup b, HasBasis a s, HasTrie (Basis a)) => a:>b+dZero :: (AdditiveGroup b, HasBasis a, HasTrie (Basis a)) => a:>b dZero = pureD zeroV  -- | Constant derivative tower.-pureD :: (AdditiveGroup b, HasBasis a s, HasTrie (Basis a)) => b -> a:>b+pureD :: (AdditiveGroup b, HasBasis a, HasTrie (Basis a)) => b -> a:>b pureD b = b `D` pure dZero   infixl 4 <$>> -- | Map a /linear/ function over a derivative tower.-fmapD, (<$>>) :: (HasTrie (Basis a), VectorSpace b s) =>+fmapD, (<$>>) :: (HasTrie (Basis a), VectorSpace b) =>                  (b -> c) -> (a :> b) -> (a :> c) fmapD f (D b0 b') = D (f b0) ((fmap.fmapD) f b') @@ -97,14 +84,14 @@ -- D f0 f' <*>> D x0 x' = D (f0 x0) (liftA2 (<*>>) f' x')  -- | Apply a /linear/ binary function over derivative towers.-liftD2 :: (HasTrie (Basis a), VectorSpace b s, VectorSpace c s, VectorSpace d s) =>+liftD2 :: (HasTrie (Basis a), VectorSpace b, VectorSpace c, VectorSpace d) =>           (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')  -- | Apply a /linear/ ternary function over derivative towers. liftD3 :: ( HasTrie (Basis a)-          , VectorSpace b s, VectorSpace c s-          , VectorSpace d s, VectorSpace e s ) =>+          , VectorSpace b, VectorSpace c+          , VectorSpace d, VectorSpace e ) =>           (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')@@ -113,8 +100,9 @@  -- | Differentiable identity function.  Sometimes called "the -- derivation variable" or similar, but it's not really a variable.-idD :: ( VectorSpace u s, VectorSpace (u :> u) (u :> s), VectorSpace s s-       , HasBasis u s, HasTrie (Basis u)) =>+idD :: ( VectorSpace u, s ~ Scalar u+       , VectorSpace (u :> u), VectorSpace s+       , HasBasis u, HasTrie (Basis u)) =>        u :~> u idD = linearD id @@ -123,10 +111,16 @@  -- | Every linear function has a constant derivative equal to the function -- itself (as a linear map).-linearD :: ( HasBasis u s, HasTrie (Basis u)-           , VectorSpace v s, VectorSpace s s ) =>+linearD :: ( HasBasis u, HasTrie (Basis u)+           , VectorSpace v ) =>            (u -> v) -> (u :~> v) +-- f :: u -> v++-- pureD . f :: u -> u:>v++-- linear (pureD . f) :: + -- linearD f u = f u `D` linear (pureD . f)  -- data a :> b = D { powVal :: b, derivative :: a :-* (a :> b) }@@ -159,30 +153,27 @@ -- linearD f = (`D` linear (pureD . f)) . f  ---- TODO: revise two previous signatures when i've added the VectorSpace instance for u:>v- -- Other examples of linear functions  -- | Differentiable version of 'fst'-fstD :: ( HasBasis a s, HasTrie (Basis a)-        , HasBasis b s, HasTrie (Basis b)-        , VectorSpace s s+fstD :: ( HasBasis a, HasTrie (Basis a)+        , HasBasis b, HasTrie (Basis b)+        , Scalar a ~ Scalar b         ) => (a,b) :~> a fstD = linearD fst  -- | Differentiable version of 'snd'-sndD :: ( HasBasis a s, HasTrie (Basis a)-        , HasBasis b s, HasTrie (Basis b)-        , VectorSpace s s+sndD :: ( HasBasis a, HasTrie (Basis a)+        , HasBasis b, HasTrie (Basis b)+        , Scalar a ~ Scalar b         ) => (a,b) :~> b sndD = linearD snd  -- | Derivative tower for applying a binary function that distributes over -- addition, such as multiplication.  A bit weaker assumption than -- bilinearity.-distrib :: ( HasBasis a s, HasTrie (Basis a)-           , VectorSpace b s, VectorSpace c s, VectorSpace u s+distrib :: ( HasBasis a, HasTrie (Basis a), VectorSpace u+           -- , VectorSpace b, VectorSpace c            ) => (b -> c -> u) -> (a :> b) -> (a :> c) -> (a :> u)  distrib op u@(D u0 u') v@(D v0 v') =@@ -201,21 +192,24 @@ instance Eq   b => Eq   (a :> b) where (==)    = noOv "(==)" instance Ord  b => Ord  (a :> b) where compare = noOv "compare" -instance (HasBasis a s, HasTrie (Basis a), VectorSpace u s) => AdditiveGroup (a :> u) where+instance (HasBasis a, HasTrie (Basis a), VectorSpace u) => AdditiveGroup (a :> u) where   zeroV   = pureD  zeroV    -- or dZero   negateV = fmapD  negateV   (^+^)   = liftD2 (^+^) -instance (HasBasis a s, HasTrie (Basis a), VectorSpace u s, VectorSpace s s)-         => VectorSpace (a :> u) (a :> s) where-  (*^) = distrib (*^)+instance ( HasBasis a, HasTrie (Basis a)+         , VectorSpace u, s ~ Scalar u+         -- , VectorSpace s, s ~ Scalar s+         )+        => VectorSpace (a :> u) where+  type Scalar (a :> u) = (a :> Scalar u)+  (*^) = distrib (*^)                      -instance ( InnerSpace u s, InnerSpace s s, VectorSpace s s-         , HasBasis a s, HasTrie (Basis a)) =>-     InnerSpace (a :> u) (a :> s) where+instance ( InnerSpace u, s ~ Scalar u, InnerSpace s, s ~ Scalar s+         , HasBasis a, HasTrie (Basis a)) =>+     InnerSpace (a :> u) where   (<.>) = distrib (<.>) - -- infixr 9 @. -- -- | Chain rule.  See also '(>-<)'. -- (@.) :: (HasTrie (Basis b), HasTrie (Basis a), VectorSpace c s) =>@@ -228,14 +222,17 @@ infix  0 >-<  -- | Specialized chain rule.  See also '(\@.)'-(>-<) :: (HasBasis a s, HasTrie (Basis a), VectorSpace s s, VectorSpace u s) =>-         (u -> u) -> ((a :> u) -> (a :> s))+(>-<) :: (HasBasis a, HasTrie (Basis a), VectorSpace u) =>+         (u -> u) -> ((a :> u) -> (a :> Scalar u))       -> (a :> u) -> (a :> u) f >-< f' = \ u@(D u0 u') -> D (f u0) (f' u *^ u') + -- TODO: express '(>-<)' in terms of '(@.)'.  If I can't, then understand why not. -instance (HasBasis a s, HasTrie (Basis a), Num s, VectorSpace s s) => Num (a:>s) where+instance ( HasBasis a, s ~ Scalar a, HasTrie (Basis a)+         , Num s, VectorSpace s, Scalar s ~ s)+      => Num (a:>s) where   fromInteger = pureD . fromInteger   (+) = liftD2  (+)   (-) = liftD2  (-)@@ -244,7 +241,8 @@   abs    = abs    >-< signum   signum = signum >-< 0  -- derivative wrong at zero -instance (HasBasis a s, HasTrie (Basis a), Fractional s, VectorSpace s s)+instance ( HasBasis a, s ~ Scalar a, HasTrie (Basis a)+         , Fractional s, VectorSpace s, Scalar s ~ s)          => Fractional (a:>s) where   fromRational = pureD . fromRational   recip        = recip >-< recip sqr@@ -252,7 +250,8 @@ sqr :: Num a => a -> a sqr x = x*x -instance (HasBasis a s, HasTrie (Basis a), Floating s, VectorSpace s s)+instance ( HasBasis a, s ~ Scalar a, HasTrie (Basis a)+         , Floating s, VectorSpace s, Scalar s ~ s)          => Floating (a:>s) where   pi    = pureD pi   exp   = exp   >-< exp

@@ -1,5 +1,5 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies -           , TypeOperators, FlexibleInstances, UndecidableInstances+{-# LANGUAGE MultiParamTypeClasses, TypeOperators+           , TypeFamilies, UndecidableInstances  #-} ---------------------------------------------------------------------- -- |@@ -10,8 +10,10 @@ -- Maintainer  :  conal@conal.net, andygill@ku.edu -- Stability   :  experimental -- --- Vector spaces.  Fundep version.  GHC-6.9 isn't quite up to the nicer--- version in @Data.VectorSpace@, which uses associated types.+-- Vector spaces+-- +-- This version uses associated types instead of fundeps and+-- requires ghc-6.10 or later ----------------------------------------------------------------------  -- NB: I'm attempting to replace fundeps with associated types.  See@@ -21,8 +23,7 @@ -- Blocking bug: http://hackage.haskell.org/trac/ghc/ticket/2448  module Data.VectorSpace-  ( -    module Data.AdditiveGroup+  ( module Data.AdditiveGroup   , VectorSpace(..), (^/), (^*)   , InnerSpace(..)   , lerp, magnitudeSq, magnitude, normalized@@ -33,85 +34,113 @@ import Data.AdditiveGroup import Data.MemoTrie -infixr 7 *^, ^/, <.>-infixl 7 ^*+infixr 7 *^  -- | Vector space @v@ over a scalar field @s@.  Extends 'AdditiveGroup' -- with scalar multiplication.-class AdditiveGroup v => VectorSpace v s | v -> s where+class AdditiveGroup v => VectorSpace v where+  type Scalar v :: *   -- | Scale a vector-  (*^)  :: s -> v -> v+  (*^)  :: Scalar v -> v -> v +infixr 7 <.>+ -- | Adds inner (dot) products.-class VectorSpace v s => InnerSpace v s where+class VectorSpace v => InnerSpace v where   -- | Inner/dot product-  (<.>) :: v -> v -> s+  (<.>) :: v -> v -> Scalar v +infixr 7 ^/+infixl 7 ^*+ -- | Vector divided by scalar-(^/) :: (Fractional s, VectorSpace v s) => v -> s -> v+(^/) :: (VectorSpace v, s ~ Scalar v, Fractional s) => v -> s -> v v ^/ s = (1/s) *^ v  -- | Vector multiplied by scalar-(^*) :: VectorSpace v s => v -> s -> v+(^*) :: (VectorSpace v, s ~ Scalar v) => v -> s -> v (^*) = flip (*^)  -- | Linear interpolation between @a@ (when @t==0@) and @b@ (when @t==1@).-lerp :: (VectorSpace v s, Num s) => v -> v -> s -> v+lerp :: (VectorSpace v, s ~ Scalar v, Num s) => v -> v -> s -> v lerp a b t = (1-t)*^a ^+^ t*^b  -- | Square of the length of a vector.  Sometimes useful for efficiency. -- See also 'magnitude'.-magnitudeSq :: InnerSpace v s => v -> s+magnitudeSq :: (InnerSpace v, s ~ Scalar v) => v -> s magnitudeSq v = v <.> v  -- | Length of a vector.   See also 'magnitudeSq'.-magnitude :: (InnerSpace v s, Floating s) =>  v -> s+magnitude :: (InnerSpace v, s ~ Scalar v, Floating s) =>  v -> s magnitude = sqrt . magnitudeSq  -- | Vector in same direction as given one but with length of one.  If -- given the zero vector, then return it.-normalized :: (InnerSpace v s, Floating s) =>  v -> v+normalized :: (InnerSpace v, s ~ Scalar v, Floating s) =>  v -> v normalized v = v ^/ magnitude v -instance VectorSpace Double Double where (*^)  = (*)-instance InnerSpace  Double Double where (<.>) = (*)+instance VectorSpace Double where+  type Scalar Double = Double+  (*^) = (*)+instance InnerSpace  Double where (<.>) = (*) -instance VectorSpace Float  Float  where (*^)  = (*)-instance InnerSpace  Float  Float  where (<.>) = (*)+instance VectorSpace Float  where+  type Scalar Float = Float+  (*^)  = (*)+instance InnerSpace  Float  where (<.>) = (*) -instance (RealFloat v, VectorSpace v s) => VectorSpace (Complex v) s where+instance (RealFloat v, VectorSpace v) => VectorSpace (Complex v) where+  type Scalar (Complex v) = Scalar v   s*^(u :+ v) = s*^u :+ s*^v -instance (RealFloat v, InnerSpace v s, AdditiveGroup s)-     => InnerSpace (Complex v) s where+instance (RealFloat v, InnerSpace v, s ~ Scalar v, AdditiveGroup s)+     => InnerSpace (Complex v) where   (u :+ v) <.> (u' :+ v') = (u <.> u') ^+^ (v <.> v')  -- Hm.  The 'RealFloat' constraint is unfortunate here.  It's due to a -- questionable decision to place 'RealFloat' into the definition of the -- 'Complex' /type/, rather than in functions and instances as needed. -instance (VectorSpace u s,VectorSpace v s) => VectorSpace (u,v) s where+-- instance (VectorSpace u,VectorSpace v, s ~ Scalar u, s ~ Scalar v)+--          => VectorSpace (u,v) where+--   type Scalar (u,v) = Scalar u+--   s *^ (u,v) = (s*^u,s*^v)++instance ( VectorSpace u, s ~ Scalar u+         , VectorSpace v, s ~ Scalar v )+      => VectorSpace (u,v) where+  type Scalar (u,v) = Scalar u   s *^ (u,v) = (s*^u,s*^v) -instance (InnerSpace u s,InnerSpace v s, AdditiveGroup s)-    => InnerSpace (u,v) s where+instance ( InnerSpace u, s ~ Scalar u+         , InnerSpace v, s ~ Scalar v+         , AdditiveGroup (Scalar v) )+    => InnerSpace (u,v) where   (u,v) <.> (u',v') = (u <.> u') ^+^ (v <.> v') -instance (VectorSpace u s,VectorSpace v s,VectorSpace w s)-    => VectorSpace (u,v,w) s where+instance ( VectorSpace u, s ~ Scalar u+         , VectorSpace v, s ~ Scalar v+         , VectorSpace w, s ~ Scalar w )+    => VectorSpace (u,v,w) where+  type Scalar (u,v,w) = Scalar u   s *^ (u,v,w) = (s*^u,s*^v,s*^w) -instance (InnerSpace u s,InnerSpace v s,InnerSpace w s, AdditiveGroup s)-    => InnerSpace (u,v,w) s where+instance ( InnerSpace u, s ~ Scalar u+         , InnerSpace v, s ~ Scalar v+         , InnerSpace w, s ~ Scalar w+         , AdditiveGroup s )+    => InnerSpace (u,v,w) where   (u,v,w) <.> (u',v',w') = u<.>u' ^+^ v<.>v' ^+^ w<.>w'   -- Standard instance for an applicative functor applied to a vector space.-instance VectorSpace v s => VectorSpace (a->v) s where+instance VectorSpace v => VectorSpace (a -> v) where+  type Scalar (a -> v) = Scalar v   (*^) s = fmap (s *^) --- No 'InnerSpace' instance for @(a->v)@.+-- No 'InnerSpace' instance for @(a -> v)@. -instance (HasTrie a, VectorSpace v s)-         => VectorSpace (a :->: v) s where-  (*^) s = fmap (s *^)+instance (HasTrie a, VectorSpace v)+         => VectorSpace (a :->: v) where+  type Scalar (a :->: v) = Scalar v+  (*^) s = fmap ((*^) s)

@@ -1,5 +1,5 @@ Name:                vector-space-Version:             0.4.1+Version:             0.5 Cabal-Version:       >= 1.2 Synopsis:            Vector & affine spaces, linear maps, and derivatives (requires ghc 6.9) Category:            math@@ -43,19 +43,11 @@                      Data.Cross                      Data.AffineSpace                      Data.NumInstances-    -  -- This library relies on type families working as well as in 6.9.-  if impl(ghc < 6.9) {+++  -- This library relies on type families working as well as in 6.10.+  if impl(ghc < 6.10) {     buildable: False-  }-  -- More bug fixes in 6.10 allow replacing some fundeps.  After a while,-  -- when 6.10 is widespread, I'll switch over entirely and eliminate the-  -- earlier versions.-  if impl(ghc >= 6.10) {-    Exposed-Modules:-                     Data.AVectorSpace-                     Data.ABasis-                     Data.ALinearMap   }   ghc-options:         -Wall -O2   ghc-prof-options:    -prof -auto-all