vector-space (empty) → 0.0

raw patch · 7 files changed

+673/−0 lines, 7 filesdep +basesetup-changed

Dependencies added: base

Files

• Makefile +3/−0
• Setup.lhs +3/−0
• src/Data/AffineSpace.hs +62/−0
• src/Data/Derivative.hs +224/−0
• src/Data/NumInstances.hs +172/−0
• src/Data/VectorSpace.hs +174/−0
• vector-space.cabal +35/−0

@@ -0,0 +1,3 @@+# For special configuration, especially for docs.  Otherwise see README.++include ../my-cabal-make.inc

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,62 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}+----------------------------------------------------------------------+-- |+-- Module      :  Data.AffineSpace+-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008+-- License     :  BSD3+-- +-- Maintainer  :  conal@conal.net, andygill@ku.edu+-- Stability   :  experimental+-- +-- Affine spaces.+----------------------------------------------------------------------++module Data.AffineSpace+  (+    AffineSpace(..), (.-^), distanceSq, distance, alerp+  ) where++import Data.VectorSpace++infix 4 .+^, .-^, .-.++class VectorSpace v s => AffineSpace p v s | p -> v s where+  -- | Subtract points+  (.-.)  :: p -> p -> v+  -- | Point plus vector+  (.+^)  :: p -> v -> p++-- TODO: consider replacing p and v with a type constructor argument:+-- +-- class VectorSpace' v => AffineSpace p v | p -> v where+--   (.-.)  :: p s -> p s -> v s+--   (.+^)  :: p s -> v s -> p s+-- +-- Perhaps with constraints on s.  We couldn't then define instances for+-- doubles & floats.++-- | Point minus vector+(.-^) :: (Num s, AffineSpace p v s) => p -> v -> 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 = (fmap.fmap) magnitudeSq (.-.)++-- | Distance between two points.  See also 'distanceSq'.+distance :: (Floating s, AffineSpace p v s, InnerSpace v s) => 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 p p' s = p .+^ (s *^ (p' .-. p))++instance  AffineSpace Double Double Double where+  (.-.)  =  (-)+  (.+^)  =  (+)++instance  AffineSpace Float Float Float where+  (.-.)  =  (-)+  (.+^)  =  (+)

@@ -0,0 +1,224 @@+{-# LANGUAGE TypeOperators, FlexibleInstances, MultiParamTypeClasses+           , UndecidableInstances+  #-}+{-# OPTIONS_GHC -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      :  Data.Derivative+-- Copyright   :  (c) Conal Elliott 2008+-- License     :  BSD3+-- +-- Maintainer  :  conal@conal.net+-- Stability   :  experimental+-- +-- Infinite derivative towers via linear maps.  See blog posts+-- <http://conal.net/blog/tag/derivatives/>+----------------------------------------------------------------------++module Data.Derivative+  (+    (:>)(..), (::>), dZero, dConst, dId, bilinearD, (>*<), (>-<)+  ) where++import Control.Applicative++import Data.VectorSpace+import Data.NumInstances ()+++infixr 9 `D`++-- | Tower of derivatives.  Values look like @b `D` b' `D` b'' `D` ...@.+-- The type of an @n@th derivative is @a :-* a :-* ... :-* b@, where there+-- are @n@ levels of @a :-*@, i.e., @(a :-*)^n b@.+-- +-- Warning, the 'Applicative' instance is missing its 'pure' (due to a+-- 'VectorSpace' type constraint).  Use 'dConst' instead.+data a :> b = D b (a :> (a :-* b))++-- | Infinitely differentiable functions+type a ::> b = a -> (a:>b)++instance Functor ((:>) a) where+  fmap f (D b b') = D (f b) (f `onDer` b')++-- I think fmap will be meaningful only with *linear* functions.++-- Lift a function to act on values inside of derivative towers+onDer :: (b -> c) -> (a :> (a :-* b)) -> (a :> (a :-* c))+onDer f = fmap (f .)++-- Or fmap.(.), or fmap.fmap++instance Applicative ((:>) a) where+    -- pure = dConst    -- not!  see below.+    pure = noOv "pure.  use dConst instead."+    D f f' <*> D b b' = D (f b) (liftA2 (<*>) f' b')++-- Why can't we define 'pure' as 'dConst'?  Because of the extra type+-- constraint that @VectorSpace b@ (not @a@).  Oh well.  Be careful not to+-- use 'pure', okay?  Alternatively, I could define the '(<*>)' (naming it+-- something else) and then say @foo <$> p <*^> q <*^> ...@.++-- | Derivative tower full of 'zeroV'.+dZero :: VectorSpace b s => a:>b+dZero = w where w = zeroV `D` dZero++-- | Constant derivative tower.+dConst :: VectorSpace b s => b -> a:>b+dConst b = b `D` dZero++-- | Tower of derivatives of the identity function.  Sometimes called "the+-- derivation variable" or similar, but it's not really a variable.+dId :: VectorSpace v s => v -> v:>v+dId v = w where w = v `D` dConst id++-- Derivative tower for applying a bilinear function, such as+-- multiplication.+bilinearD :: VectorSpace w s =>+             (u -> v -> w) -> (t :> u) -> (t :> v) -> (t :> w)+bilinearD op (D s s') (D u u') =+  D (s `op` u) ((s `op`) `onDer` u' ^+^ (`op` u) `onDer` s')+++-- Handy for missing methods.+noOv :: String -> a+noOv op = error (op ++ ": not defined on a :> b")++-- 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"++instance VectorSpace u s => VectorSpace (a :> u) (a :> s) where+  zeroV   = dConst    zeroV    -- or dZero+  (*^)    = bilinearD (*^)+  negateV = fmap      negateV+  (^+^)   = liftA2    (^+^)+++infix 0 >*<++-- | Convenient encapsulation of the chain rule.  Combines value function+-- and derivative function, to get a infinitely differentiability+-- function, which is then applied to a derivative tower.+(>*<) :: (b -> c) -> (b -> (b :-* c))+      -> (a :> b) -> (a :> c)+f >*< f' = \ (D u u') -> D (f u) ((f' u .) <$> u')++-- Compare with:+-- +--   f >-< f' = \ (D u u') -> D (f u) (f' u *^ u')+-- +-- which is equivalent to+-- +--   f >-< f' = \ (D u u') -> D (f u) ((f' u *^) <$> u')+-- +-- thanks to the 'VectorSpace' instance of @a :> b@++-- Also, we could have said+-- +--   f >*< f' = \ (D u u') -> D (f u) ((fmap.fmap) (f' u) u')+-- +-- because (.) and (<$>) are both 'fmap'.+++-- Specialized chain rule.  Scalar range.+infix 0 >-<+-- | Specialized form of '(>*<)', convenient for functions with scalar+-- values.  Uses the more common view of derivatives as rate-of-change.+(>-<) :: VectorSpace b s => (b -> b) -> (b -> s)+      -> (a :> b) -> (a :> b)+f >-< f' = f >*< ((*^) . f')++-- Equivalently:+-- +--   f >-< f' = f >:< \ u -> (f' u *^)+-- or+--            = \ (D u u') -> D (f u) (f' u *^ u')+-- +-- Corresponding to the usual chain rule for scalar domains:+--   D (f . g) x = D f (g x) *^ D g x+++-- Note that the two arguments of (>*<) have the same info as @a ::> b@.+-- Define composition functions as I did in DifL.+++instance (Num b, VectorSpace b b) => Num (a:>b) where+  fromInteger = dConst . fromInteger+  (+) = liftA2    (+)+  (-) = liftA2    (-)+  (*) = bilinearD (*)+  +  negate = negate >-< -1+  abs    = abs    >-< signum+  signum = signum >-< 0  -- derivative wrong at zero++instance (Fractional b, VectorSpace b b) => Fractional (a:>b) where+  fromRational = dConst . fromRational+  recip        = recip >-< recip sqr++sqr :: Num a => a -> a+sqr x = x*x++instance (Floating b, VectorSpace b b) => Floating (a:>b) where+  pi    = dConst pi+  exp   = exp   >-< exp+  log   = log   >-< recip+  sqrt  = sqrt  >-< recip (2 * sqrt)+  sin   = sin   >-< cos+  cos   = cos   >-< - sin+  sinh  = sinh  >-< cosh+  cosh  = cosh  >-< sinh+  asin  = asin  >-< recip (sqrt (1-sqr))+  acos  = acos  >-< recip (- sqrt (1-sqr))+  atan  = atan  >-< recip (1+sqr)+  asinh = asinh >-< recip (sqrt (1+sqr))+  acosh = acosh >-< recip (- sqrt (sqr-1))+  atanh = atanh >-< recip (1-sqr)+++++-- infixl 9 @$+-- -- Application, with chain rule+-- (@$) :: b ::> c -> a :> b -> a :> c+-- g @$ u = D c ((fmap.fmap) c' b')+--  where+--    D b b' = u+--    D c c' = g b++-- b  :: b+-- b' :: a :> (a :-* b)++-- c  :: c+-- c' :: b :> (b :-* c)++-- b  = f x+-- b' = D f x++-- c  = g (f x)+-- c' = D g (f x)+++-- D (g . f) x = D g (f x) . D f x+--  == c' . b'+++++-- g @$ D b b' = D c (c' . b')+--  where+--    D c c' = g b+++-- -- Composition, with chain rule+-- infixr 9 @.+-- (@.) :: b ::> c -> a ::> b -> a ::> c+-- (g @. f) a = g @$ f a++-- (g @. f) a = D c (c' . b')+--  where+--    D b b' = f a+--    D c c' = g b

@@ -0,0 +1,172 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+----------------------------------------------------------------------+-- |+-- Module      :  Data.NumInstances+-- Copyright   :  (c) Conal Elliott 2008+-- License     :  BSD3+-- +-- Maintainer  :  conal@conal.net+-- Stability   :  experimental+-- +-- Number class instances for functions and tuples+----------------------------------------------------------------------++module Data.NumInstances () where++import Control.Applicative++noOv :: String -> String -> a+noOv ty meth = error $ meth ++ ": No overloading for " ++ ty++noFun :: String -> a+noFun = noOv "function"++-- Eq & Show are prerequisites for Num, so they need to be faked here+instance Eq (a->b) where+  (==) = noFun "(==)"+  (/=) = noFun "(/=)"++instance Ord b => Ord (a->b) where+  min = liftA2 min+  max = liftA2 max++instance Show (a->b) where+  show      = noFun "show"+  showsPrec = noFun "showsPrec"+  showList  = noFun "showList"++instance Num b => Num (a->b) where+  negate      = fmap negate+  (+)         = liftA2 (+)+  (*)         = liftA2 (*)+  fromInteger = pure . fromInteger+  abs         = fmap abs+  signum      = fmap signum++instance Fractional b => Fractional (a->b) where+  recip        = fmap recip+  fromRational = pure . fromRational++instance Floating b => Floating (a->b) where+  pi    = pure pi+  sqrt  = fmap sqrt+  exp   = fmap exp+  log   = fmap log+  sin   = fmap sin+  cos   = fmap cos+  asin  = fmap asin+  atan  = fmap atan+  acos  = fmap acos+  sinh  = fmap sinh+  cosh  = fmap cosh+  asinh = fmap asinh+  atanh = fmap atanh+  acosh = fmap acosh+++----- Tuples++lift2 :: (a->u) -> (b->v) -> (a,b) -> (u,v)+lift2 f g (a,b) = (f a, g b)++instance (Num a, Num b) => Num (a,b) where+  fromInteger n   = (fromInteger n, fromInteger n)+  (a,b) + (a',b') = (a+a',b+b')+  (a,b) - (a',b') = (a-a',b-b')+  (a,b) * (a',b') = (a*a',b*b')+  negate = lift2 negate negate+  abs    = lift2 abs abs+  signum = lift2 signum signum++instance (Fractional a, Fractional b) => Fractional (a,b) where+  fromRational x = (fromRational x, fromRational x)+  recip = lift2 recip recip++instance (Floating a, Floating b) => Floating (a,b) where+  pi    = (pi,pi)+  exp   = lift2 exp exp+  log   = lift2 log log+  sqrt  = lift2 sqrt sqrt+  sin   = lift2 sin sin+  cos   = lift2 cos cos+  sinh  = lift2 sinh sinh+  cosh  = lift2 cosh cosh+  asin  = lift2 asin asin+  acos  = lift2 acos acos+  atan  = lift2 atan atan+  asinh = lift2 asinh asinh+  acosh = lift2 acosh acosh+  atanh = lift2 atanh atanh++instance (Num a, Num b, Num c) => Num (a,b,c) where+  fromInteger n = (fromInteger n, fromInteger n, fromInteger n)+  (a,b,c) + (a',b',c') = (a+a',b+b',c+c')+  (a,b,c) - (a',b',c') = (a-a',b-b',c-c')+  (a,b,c) * (a',b',c') = (a*a',b*b',c*c')+  negate = lift3 negate negate negate+  abs    = lift3 abs abs abs+  signum = lift3 signum signum signum++instance (Fractional a, Fractional b, Fractional c)+    => Fractional (a,b,c) where+  fromRational x = (fromRational x, fromRational x, fromRational x)+  recip = lift3 recip recip recip+++lift3 :: (a->u) -> (b->v) -> (c->w) -> (a,b,c) -> (u,v,w)+lift3 f g h (a,b,c) = (f a, g b, h c)++instance (Floating a, Floating b, Floating c)+    => Floating (a,b,c) where+  pi    = (pi,pi,pi)+  exp   = lift3 exp exp exp+  log   = lift3 log log log+  sqrt  = lift3 sqrt sqrt sqrt+  sin   = lift3 sin sin sin+  cos   = lift3 cos cos cos+  sinh  = lift3 sinh sinh sinh+  cosh  = lift3 cosh cosh cosh+  asin  = lift3 asin asin asin+  acos  = lift3 acos acos acos+  atan  = lift3 atan atan atan+  asinh = lift3 asinh asinh asinh+  acosh = lift3 acosh acosh acosh+  atanh = lift3 atanh atanh atanh++++lift4 :: (a->u) -> (b->v) -> (c->w) -> (d->x)+      -> (a,b,c,d) -> (u,v,w,x)+lift4 f g h k (a,b,c,d) = (f a, g b, h c, k d)++instance (Num a, Num b, Num c, Num d) => Num (a,b,c,d) where+  fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n)+  (a,b,c,d) + (a',b',c',d') = (a+a',b+b',c+c',d+d')+  (a,b,c,d) - (a',b',c',d') = (a-a',b-b',c-c',d-d')+  (a,b,c,d) * (a',b',c',d') = (a*a',b*b',c*c',d*d')+  negate = lift4 negate negate negate negate+  abs    = lift4 abs abs abs abs+  signum = lift4 signum signum signum signum++instance (Fractional a, Fractional b, Fractional c, Fractional d)+    => Fractional (a,b,c,d) where+  fromRational x = (fromRational x, fromRational x, fromRational x, fromRational x)+  recip = lift4 recip recip recip recip++instance (Floating a, Floating b, Floating c, Floating d)+    => Floating (a,b,c,d) where+  pi    = (pi,pi,pi,pi)+  exp   = lift4 exp exp exp exp+  log   = lift4 log log log log+  sqrt  = lift4 sqrt sqrt sqrt sqrt+  sin   = lift4 sin sin sin sin+  cos   = lift4 cos cos cos cos+  sinh  = lift4 sinh sinh sinh sinh+  cosh  = lift4 cosh cosh cosh cosh+  asin  = lift4 asin asin asin asin+  acos  = lift4 acos acos acos acos+  atan  = lift4 atan atan atan atan+  asinh = lift4 asinh asinh asinh asinh+  acosh = lift4 acosh acosh acosh acosh+  atanh = lift4 atanh atanh atanh atanh

@@ -0,0 +1,174 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies +           , FlexibleInstances, FlexibleContexts, UndecidableInstances+ #-}+----------------------------------------------------------------------+-- |+-- Module      :   Data.VectorSpace+-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008+-- License     :  BSD3+-- +-- Maintainer  :  conal@conal.net, andygill@ku.edu+-- Stability   :  experimental+-- +-- Vector spaces+----------------------------------------------------------------------++module Data.VectorSpace+  ( +    VectorSpace(..), (^-^), (^/), (^*)+  , InnerSpace(..) --, Scalar+  , lerp, magnitudeSq, magnitude, normalized+  , (:-*)+  ) where++import Control.Applicative++infixr 7 *^, ^/, <.>+infixl 7 ^*+infixl 6 ^+^, ^-^++-- | Vector space @v@ over a scalar field @s@+class VectorSpace v s | v -> s where+  -- | The zero vector+  zeroV :: v+  -- | Scale a vector+  (*^)  :: s -> v -> v+  -- | Add vectors+  (^+^) :: v -> v -> v+  -- | Additive inverse+  negateV :: v -> v++-- | Adds inner (dot) products+class VectorSpace v s => InnerSpace v s | v -> s where+  -- | Inner/dot product+  (<.>) :: v -> v -> s++-- | Convenience.  Maybe add methods later.+-- class VectorSpace s s => Scalar s++-- TODO: consider replacing v with a type constructor argument:+-- +-- class VectorSpace v where+--   zeroV :: v s+--   (*^)  :: s -> v s -> v s+--   (^+^) :: v s -> v s -> v s+--   (<.>)   :: v s -> v s -> s+-- +-- Perhaps with constraints on s.  We couldn't then define instances for+-- doubles & floats.++-- | Vector subtraction+(^-^) :: VectorSpace v s => v -> v -> v+v ^-^ v' = v ^+^ negateV v'++-- | Vector divided by scalar+(^/) :: (Fractional s, VectorSpace v s) => v -> s -> v+v ^/ s = (1/s) *^ v++-- | Vector multiplied by scalar+(^*) :: VectorSpace v s => 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 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 v = v <.> v++-- | Length of a vector.   See also 'magnitudeSq'.+magnitude :: (InnerSpace v s, 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 v | mag /= 0  = v ^/ mag+             | otherwise = v+  where+    mag = magnitude v++instance VectorSpace Double Double where+  zeroV   = 0.0+  (*^)    = (*)+  (^+^)   = (+)+  negateV = negate++instance InnerSpace Double Double where+ (<.>) = (*)++instance VectorSpace Float Float where+  zeroV   = 0.0+  (*^)    = (*)+  (^+^)   = (+)+  negateV = negate++instance InnerSpace Float Float where+  (<.>) = (*)++-- With UndecidableInstances, I get+--   Illegal instance declaration for `VectorSpace (u, v) s' (the+--   Coverage Condition fails for one of the functional dependencies ...)++instance (VectorSpace u s,VectorSpace v s) => VectorSpace (u,v) s where+  zeroV             = (zeroV,zeroV)+  s *^ (u,v)        = (s*^u,s*^v)+  (u,v) ^+^ (u',v') = (u^+^u',v^+^v')+  negateV (u,v)     = (negateV u, negateV v)++instance (InnerSpace u s,InnerSpace v s, VectorSpace s s')+    => InnerSpace (u,v) s where+  (u,v) <.> (u',v') = (u <.> u') ^+^ (v <.> v')++-- We could use @Num s@ and @(+)@ in place of @VectorSpace s s'@ and @(^+^)@+-- in the @InnerSpace@ instances for pairs and triples.++instance (VectorSpace u s,VectorSpace v s,VectorSpace w s)+    => VectorSpace (u,v,w) s where+  zeroV                  = (zeroV,zeroV,zeroV)+  s *^ (u,v,w)           = (s*^u,s*^v,s*^w)+  (u,v,w) ^+^ (u',v',w') = (u^+^u',v^+^v',w^+^w')+  negateV (u,v,w)        = (negateV u, negateV v, negateV w)++instance (InnerSpace u s,InnerSpace v s,InnerSpace w s, VectorSpace s s')+    => InnerSpace (u,v,w) s 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+  zeroV   = pure   zeroV+  (*^) s  = fmap (s *^)+  (^+^)   = liftA2 (^+^)+  negateV = fmap negateV++-- I don't know how to make the InnerSpace class work out, because the+-- inner product would have to combine two vector *functions* into a+-- scalar value.+-- +--   instance InnerSpace v s => InnerSpace (a->v) s where+--     (<.>) = ???++-- Alternatively, we could use (a->s) as the scalar field:+-- +--   -- Standard instance for an applicative functor applied to a vector space.+--   instance VectorSpace v s => VectorSpace (a->v) (a->s) where+--     zeroV   = pure   zeroV+--     (*^)    = liftA2 (*^)+--     (^+^)   = liftA2 (^+^)+--     negateV = fmap negateV+-- +--   instance InnerSpace v s => InnerSpace (a->v) (a->s) where+--     (<.>) = liftA2 (<.>)+-- +-- This definition, however, doesn't fit the standard notion of linear+-- maps as vector spaces.+++-- | Linear transformations/maps.  For now, represented as simple+-- functions.  The 'VectorSpace' instance for functions gives the usual+-- meaning for a vector space of linear transformations.++type a :-* b = a -> b

@@ -0,0 +1,35 @@+Name:                vector-space+Version:             0.0+Synopsis: 	     Vector & affine spaces, plus +Category:            math+Description:+  vector-space provides classes and generic operations for vector+  spaces and affine spaces.  It also defines a type of infinite towers+  of generalized derivatives.  A generalized derivative is a linear+  transformation rather than one of the usual concrete representations+  (scalars, vectors, matrices, ...).+  .+  Project wiki page: <http://haskell.org/haskellwiki/vector-space>+  .+  The module documentation pages have links to colorized source code and+  to wiki pages where you can read and contribute user comments.  Enjoy!+  .+  &#169; 2008 by Conal Elliott; BSD3 license.+Author:              Conal Elliott +Maintainer:          conal@conal.net+Homepage:            http://haskell.org/haskellwiki/vector-space+Package-Url:	     http://darcs.haskell.org/vector-space+Copyright:           (c) 2007-2008 by Conal Elliott+License:             BSD3+Stability:           experimental+build-type:	     Simple+Hs-Source-Dirs:      src+Extensions:          +Build-Depends:       base+Exposed-Modules:     +		     Data.VectorSpace+		     Data.Derivative+		     Data.AffineSpace+		     Data.NumInstances+		     +ghc-options:         -Wall -O2