diff --git a/src/Data/ABasis.hs b/src/Data/ABasis.hs new file mode 100644 --- /dev/null +++ b/src/Data/ABasis.hs @@ -0,0 +1,135 @@ +-- 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) + +-} diff --git a/src/Data/ALinearMap.hs b/src/Data/ALinearMap.hs new file mode 100644 --- /dev/null +++ b/src/Data/ALinearMap.hs @@ -0,0 +1,44 @@ +{-# 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 diff --git a/src/Data/AVectorSpace.hs b/src/Data/AVectorSpace.hs new file mode 100644 --- /dev/null +++ b/src/Data/AVectorSpace.hs @@ -0,0 +1,147 @@ +{-# 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) diff --git a/src/Data/AdditiveGroup.hs b/src/Data/AdditiveGroup.hs --- a/src/Data/AdditiveGroup.hs +++ b/src/Data/AdditiveGroup.hs @@ -40,6 +40,11 @@ sumV :: AdditiveGroup v => [v] -> v sumV = foldr (^+^) zeroV +instance AdditiveGroup () where + zeroV = () + () ^+^ () = () + negateV = id + instance AdditiveGroup Double where zeroV = 0.0 (^+^) = (+) @@ -62,17 +67,17 @@ instance (AdditiveGroup u,AdditiveGroup v) => AdditiveGroup (u,v) where zeroV = (zeroV,zeroV) (u,v) ^+^ (u',v') = (u^+^u',v^+^v') - negateV (u,v) = (negateV u, negateV v) + negateV (u,v) = (negateV u,negateV v) instance (AdditiveGroup u,AdditiveGroup v,AdditiveGroup w) => AdditiveGroup (u,v,w) where zeroV = (zeroV,zeroV,zeroV) (u,v,w) ^+^ (u',v',w') = (u^+^u',v^+^v',w^+^w') - negateV (u,v,w) = (negateV u, negateV v, negateV w) + negateV (u,v,w) = (negateV u,negateV v,negateV w) -- Standard instance for an applicative functor applied to a vector space. -instance AdditiveGroup v => AdditiveGroup (u->v) where +instance AdditiveGroup v => AdditiveGroup (a -> v) where zeroV = pure zeroV (^+^) = liftA2 (^+^) negateV = fmap negateV diff --git a/src/Data/Basis.hs b/src/Data/Basis.hs --- a/src/Data/Basis.hs +++ b/src/Data/Basis.hs @@ -15,51 +15,76 @@ -- Maintainer : conal@conal.net -- Stability : experimental -- --- Basis of a vector space, as an associated type +-- Basis of a vector space, as an associated type. +-- This version works with @Data.VectorSpace@, thus avoiding a bug in +-- ghc-6.9.. ---------------------------------------------------------------------- -module Data.Basis - ( - HasBasis(..) - ) where +module Data.Basis (HasBasis(..), linearCombo, recompose) where -import Control.Arrow (second) +import Control.Arrow (first) import Data.Either import Data.VectorSpace class VectorSpace v s => HasBasis v s where + -- | Representation of the canonical basis for @v@ type Basis v :: * - basisValue :: Basis v -> v - decompose :: v -> [(s, Basis v)] + -- | Interpret basis rep as a vector + basisValue :: Basis v -> v + -- | Extract coordinates + decompose :: v -> [(Basis v, s)] + -- | 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 +-- 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. +-- Defining property: recompose . decompose == id + +-- | Linear combination +linearCombo :: VectorSpace v s => [(v,s)] -> 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 +recompose = linearCombo . fmap (first basisValue) + +-- recompose ps = linearCombo (first basisValue <$> ps) + + +-- recompose = sumV . fmap (\ (b,s) -> s *^ basisValue b) + instance HasBasis Float Float where type Basis Float = () basisValue () = 1 - decompose s = [(s,())] + decompose s = [((),s)] + decompose' s = const s instance HasBasis Double Double where type Basis Double = () basisValue () = 1 - decompose s = [(s,())] + decompose s = [((),s)] + decompose' s = const s instance (HasBasis u s, HasBasis v s) => HasBasis (u,v) s 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) = decomp2 Left u ++ decomp2 Right v + decompose' (u,v) = decompose' u `either` decompose' v -decomp2 :: HasBasis w s => (Basis w -> b) -> w -> [(s, b)] -decomp2 inject = fmap (second inject) . decompose +decomp2 :: HasBasis w s => (Basis w -> b) -> w -> [(b, s)] +decomp2 inject = fmap (first inject) . decompose instance (HasBasis u s, HasBasis v s, HasBasis w s) => HasBasis (u,v,w) s 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) @@ -79,6 +104,15 @@ -- -- type Basis (u,v,w) = Basis u `Either` Basis (v,w) + +instance (Eq a, HasBasis u s) => HasBasis (a -> u) s 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 {- diff --git a/src/Data/LinearMap.hs b/src/Data/LinearMap.hs --- a/src/Data/LinearMap.hs +++ b/src/Data/LinearMap.hs @@ -16,18 +16,15 @@ module Data.LinearMap ( (:-*) , linear, lapply - -- , inL, inL2, inL3 ) where --- -fglasgow-exts above enables the RULES pragma - +import Control.Arrow (first) import Data.Function import Data.VectorSpace import Data.MemoTrie import Data.Basis - -- | Linear map, represented a as a memo function from basis to values. type u :-* v = Basis u :->: v @@ -39,20 +36,8 @@ -- | Apply a linear map to a vector. lapply :: (VectorSpace u s, VectorSpace v s, HasBasis u s, HasTrie (Basis u)) => (u :-* v) -> (u -> v) -lapply lm u = sumV [s *^ (lm `untrie` b) | (s,b) <- decompose u] +lapply lm = linearCombo . fmap (first (untrie lm)) . decompose -- TODO: unfst, unsnd, pair, unpair - ----- OpenGL stuff. - --- I'd rather this code be in a different package. It's here as a --- temporary bug workaround. In ghc-6.8.2, I get the following error --- message if the 'LMapDom' instance (below) is compiled in a separate --- module. --- --- Type indexes must match class instance head --- Found o but expected Vector2 u --- In the associated type instance for `:-*' --- In the instance declaration for `LMapDom (Vector2 u) s' diff --git a/src/Data/Maclaurin.hs b/src/Data/Maclaurin.hs --- a/src/Data/Maclaurin.hs +++ b/src/Data/Maclaurin.hs @@ -33,14 +33,10 @@ (:>), powVal, derivative --, derivativeAt , (:~>), dZero, pureD , fmapD, (<$>>){-, (<*>>)-}, liftD2, liftD3 - , idD -- , fstD, sndD + , idD, fstD, sndD , linearD, distrib -- , (@.) , (>-<) - ,(**^), (<*.>) - -- , HasDeriv(..) - -- experimental - -- , liftD3 ) where @@ -127,7 +123,7 @@ -- | Every linear function has a constant derivative equal to the function -- itself (as a linear map). -linearD :: ( HasBasis u s, HasTrie (Basis u){-, VectorSpace (u :> v) s, -} +linearD :: ( HasBasis u s, HasTrie (Basis u) , VectorSpace v s, VectorSpace s s ) => (u -> v) -> (u :~> v) @@ -166,64 +162,41 @@ -- 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 :: -- (VectorSpace a s, HasBasis a s, HasTrie (Basis a), HasBasis b s, HasTrie (Basis b)) => - ( HasBasis a s, HasTrie (Basis a) +fstD :: ( HasBasis a s, HasTrie (Basis a) , HasBasis b s, HasTrie (Basis b) - , HasBasis (a,b) s, HasTrie (Basis (a, b)) - ) => - (a,b) :~> a + , VectorSpace s s + ) => (a,b) :~> a fstD = linearD fst --- wtf: --- --- Data/NewMaclaurin.hs:138:7: --- Could not deduce (HasTrie (Basis (a, b))) --- from the context (HasBasis a s, --- HasTrie (Basis a), --- HasBasis b s, --- HasTrie (Basis b), --- HasBasis (a, b) s, --- HasTrie (Basis (a, b))) --- arising from a use of `linearD' at Data/NewMaclaurin.hs:138:7-17 --- Possible fix: --- add (HasTrie (Basis (a, b))) to the context of --- the type signature for `fstD' --- or add an instance declaration for (HasTrie (Basis (a, b))) --- In the expression: linearD fst --- In the definition of `fstD': fstD = linearD fst --- Failed, modules loaded: Data.MemoTrie, Data.Basis, Data.VectorSpace, Data.AdditiveGroup, Data.NumInstances. --- *Data.Basis> - --- -- | Differentiable version of 'snd' --- sndD :: (VectorSpace b s, HasBasis b s, HasTrie (Basis b), HasTrie (Basis a)) => (a,b) :~> b --- sndD = linearD snd - --} +-- | Differentiable version of 'snd' +sndD :: ( HasBasis a s, HasTrie (Basis a) + , HasBasis b s, HasTrie (Basis b) + , VectorSpace s s + ) => (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) => - (b -> c -> u) -> (a :> b) -> (a :> c) -> (a :> u) + , VectorSpace b s, VectorSpace c s, VectorSpace u s + ) => (b -> c -> u) -> (a :> b) -> (a :> c) -> (a :> u) distrib op u@(D u0 u') v@(D v0 v') = D (u0 `op` v0) (trie (\ da -> distrib op u (v' `untrie` da) ^+^ distrib op (u' `untrie` da) v)) --- TODO: look for a simpler definition of distrib. See inTrie2. +-- TODO: look for a simpler definition of distrib. See the applicative +-- instance for @(:->:) a@, or define @inTrie2@. + -- TODO: This distrib is exponential in increasing degree. Switch to the -- Horner representation. See /The Music of Streams/ by Doug McIlroy. --- I'm not sure about the next three, which discard information - instance Show b => Show (a :> b) where show = noOv "show" instance Eq b => Eq (a :> b) where (==) = noOv "(==)" instance Ord b => Ord (a :> b) where compare = noOv "compare" @@ -233,37 +206,14 @@ negateV = fmapD negateV (^+^) = liftD2 (^+^) -{- -instance (HasBasis a s, HasTrie (Basis a), VectorSpace u s) => VectorSpace (a :> u) s where - (*^) s = fmapD ((*^) s) --} - -(**^) :: (HasBasis a s, HasTrie (Basis a), VectorSpace c s, VectorSpace s s) => - (a :> s) -> (a :> c) -> (a :> c) -(**^) = distrib (*^) - --- ouch! InnerSpace one won't work at all, for the same reason as for functions. - --- instance (InnerSpace u s) => InnerSpace (a :> u) s where --- (<.>) = distrib (<.>) - -(<*.>) :: (HasBasis a s, HasTrie (Basis a), InnerSpace b s, VectorSpace s s) => - (a :> b) -> (a :> b) -> (a :> s) -(<*.>) = distrib (<.>) - - --- The instances below are the one I think we'll want externally. --- However, the ones above allow the definition of @a:>b@ to work out. --- The module "Data.Mac" rewraps to provide the alternate instances. - instance (HasBasis a s, HasTrie (Basis a), VectorSpace u s, VectorSpace s s) => VectorSpace (a :> u) (a :> s) where - (*^) = (**^) + (*^) = distrib (*^) -instance ( InnerSpace u s, InnerSpace s s', VectorSpace s s +instance ( InnerSpace u s, InnerSpace s s, VectorSpace s s , HasBasis a s, HasTrie (Basis a)) => InnerSpace (a :> u) (a :> s) where - (<.>) = (<*.>) + (<.>) = distrib (<.>) -- infixr 9 @. @@ -281,7 +231,7 @@ (>-<) :: (HasBasis a s, HasTrie (Basis a), VectorSpace s s, VectorSpace u s) => (u -> u) -> ((a :> u) -> (a :> s)) -> (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) (f' u *^ u') -- TODO: express '(>-<)' in terms of '(@.)'. If I can't, then understand why not. diff --git a/src/Data/VectorSpace.hs b/src/Data/VectorSpace.hs --- a/src/Data/VectorSpace.hs +++ b/src/Data/VectorSpace.hs @@ -10,7 +10,8 @@ -- Maintainer : conal@conal.net, andygill@ku.edu -- Stability : experimental -- --- Vector spaces +-- Vector spaces. Fundep version. GHC-6.9 isn't quite up to the nicer +-- version in @Data.VectorSpace@, which uses associated types. ---------------------------------------------------------------------- -- NB: I'm attempting to replace fundeps with associated types. See @@ -111,9 +112,6 @@ -- No 'InnerSpace' instance for @(a->v)@. -instance (HasTrie u, VectorSpace v s, AdditiveGroup (u :->: v)) - => VectorSpace (u :->: v) s where +instance (HasTrie a, VectorSpace v s) + => VectorSpace (a :->: v) s where (*^) s = fmap (s *^) - --- The 'AdditiveGroup' constraint is implied by the others, thanks to the --- instance in Data.AdditiveGroup. Why isn't ghc figuring it out? diff --git a/vector-space.cabal b/vector-space.cabal --- a/vector-space.cabal +++ b/vector-space.cabal @@ -1,5 +1,5 @@ Name: vector-space -Version: 0.3.1 +Version: 0.4 Cabal-Version: >= 1.2 Synopsis: Vector & affine spaces, linear maps, and derivatives (requires ghc 6.9) Category: math @@ -28,35 +28,35 @@ Stability: experimental build-type: Simple --- WARNING: Data.Basis depends on type families working fairly well, --- and requires ghc version at least 6.9. I don't know how to specify --- that dependency in the .cabal. - Library hs-Source-Dirs: src Extensions: Build-Depends: base, MemoTrie Exposed-Modules: - Data.AdditiveGroup Data.VectorSpace Data.Basis Data.LinearMap Data.Maclaurin +-- Data.Horner Data.Derivative Data.Cross Data.AffineSpace Data.NumInstances + + -- This library relies on type families working as well as in 6.9. + if impl(ghc < 6.9) { + 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 --- -fno-method-sharing - --- Executable Perf --- main-is: Perf.hs --- build-depends: base, OpenGL, old-time --- Hs-Source-Dirs: src, tests/src --- ghc-options: -Wall -O2 --- ghc-prof-options: -prof -auto-all - --- Data.Horner -- For ghc-options: -ddump-simpl-stats -ddump-rules -ddump-simpl -ddump-simpl-phases