packages feed

linear 0.6.1 → 0.7

raw patch · 11 files changed

+369/−43 lines, 11 filesdep +base-orphansdep +containersdep +hashablePVP ok

version bump matches the API change (PVP)

Dependencies added: base-orphans, containers, hashable, semigroupoids, semigroups, unordered-containers

API changes (from Hackage documentation)

- Linear.Vector: gnegate :: (Functor f, Num a) => f a -> f a
+ Linear.Instances: instance (Hashable k, Eq k) => Apply (HashMap k)
+ Linear.Instances: instance (Hashable k, Eq k) => Bind (HashMap k)
+ Linear.Instances: instance Applicative Complex
+ Linear.Instances: instance Apply Complex
+ Linear.Instances: instance Bind Complex
+ Linear.Instances: instance Foldable Complex
+ Linear.Instances: instance Foldable1 Complex
+ Linear.Instances: instance Functor Complex
+ Linear.Instances: instance Monad Complex
+ Linear.Instances: instance Traversable Complex
+ Linear.Instances: instance Traversable1 Complex
+ Linear.Plucker: instance Additive Plucker
+ Linear.Plucker: instance Apply Plucker
+ Linear.Plucker: instance Bind Plucker
+ Linear.Plucker: instance Foldable1 Plucker
+ Linear.Plucker: instance Traversable1 Plucker
+ Linear.Quaternion: instance Additive Quaternion
+ Linear.Quaternion: instance Apply Quaternion
+ Linear.Quaternion: instance Bind Quaternion
+ Linear.V2: instance Additive V2
+ Linear.V2: instance Apply V2
+ Linear.V2: instance Bind V2
+ Linear.V2: instance Foldable1 V2
+ Linear.V2: instance Traversable1 V2
+ Linear.V3: instance Additive V3
+ Linear.V3: instance Apply V3
+ Linear.V3: instance Bind V3
+ Linear.V3: instance Foldable1 V3
+ Linear.V3: instance Traversable1 V3
+ Linear.V4: instance Additive V4
+ Linear.V4: instance Apply V4
+ Linear.V4: instance Bind V4
+ Linear.V4: instance Foldable1 V4
+ Linear.V4: instance Traversable1 V4
+ Linear.Vector: class Bind f => Additive f where zero = pure 0 ^+^ = liftA2 (+) ^-^ = liftA2 (-) lerp alpha u v = alpha *^ u ^+^ (1 - alpha) *^ v
+ Linear.Vector: instance (Eq k, Hashable k) => Additive (HashMap k)
+ Linear.Vector: instance Additive ((->) b)
+ Linear.Vector: instance Additive Complex
+ Linear.Vector: instance Additive IntMap
+ Linear.Vector: instance Ord k => Additive (Map k)
+ Linear.Vector: negated :: (Functor f, Num a) => f a -> f a
+ Linear.Vector: zero :: (Additive f, Num a) => f a
- Linear.Matrix: (!*!) :: (Functor m, Foldable r, Applicative r, Distributive n, Num a) => m (r a) -> r (n a) -> m (n a)
+ Linear.Matrix: (!*!) :: (Functor m, Foldable r, Apply r, Distributive n, Num a) => m (r a) -> r (n a) -> m (n a)
- Linear.Vector: (^+^) :: (Applicative f, Num a) => f a -> f a -> f a
+ Linear.Vector: (^+^) :: (Additive f, Num a) => f a -> f a -> f a
- Linear.Vector: (^-^) :: (Applicative f, Num a) => f a -> f a -> f a
+ Linear.Vector: (^-^) :: (Additive f, Num a) => f a -> f a -> f a
- Linear.Vector: lerp :: (Applicative f, Num a) => a -> f a -> f a -> f a
+ Linear.Vector: lerp :: (Additive f, Num a) => a -> f a -> f a -> f a

Files

README.markdown view
@@ -1,6 +1,8 @@ linear ====== +Highly polymorphic vector space operations on sparse and free vector spaces.+ Contact Information ------------------- 
linear.cabal view
@@ -1,6 +1,6 @@ name:          linear category:      Math, Algebra-version:       0.6.1+version:       0.7 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -11,7 +11,7 @@ bug-reports:   http://github.com/ekmett/linear/issues copyright:     Copyright (C) 2012-2013 Edward A. Kmett synopsis:      Linear Algebra-description:   Types and combinators for low-dimension-count linear algebra on free vector spaces+description:   Types and combinators for linear algebra on free vector spaces build-type:    Custom tested-with:   GHC == 7.4.1, GHC == 7.4.2, GHC == 7.6.1 extra-source-files:@@ -31,13 +31,19 @@ library   build-depends:     base             >= 4.5 && < 5,-    distributive     >= 0.2.2+    containers       >= 0.4 && < 0.5,+    distributive     >= 0.2.2,+    hashable         >= 1.1 && < 1.3,+    semigroups       >= 0.9,+    semigroupoids    >= 3,+    unordered-containers >= 0.2.3    exposed-modules:     Linear     Linear.Conjugate     Linear.Core     Linear.Epsilon+    Linear.Instances     Linear.Matrix     Linear.Metric     Linear.Plucker
src/Linear.hs view
@@ -28,6 +28,7 @@ import Linear.Conjugate import Linear.Core import Linear.Epsilon+import Linear.Instances () import Linear.Matrix import Linear.Metric import Linear.Plucker
+ src/Linear/Instances.hs view
@@ -0,0 +1,77 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Linear.Instances+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- Orphans+-----------------------------------------------------------------------------+module Linear.Instances () where++import Control.Applicative+import Data.Complex+import Data.Foldable+import Data.Functor.Bind+import Data.HashMap.Lazy as HashMap+import Data.Hashable+import Data.Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Data.Traversable++instance (Hashable k, Eq k) => Apply (HashMap k) where+  (<.>) = HashMap.intersectionWith id++instance (Hashable k, Eq k) => Bind (HashMap k) where+  -- this is needlessly painful+  m >>- f = HashMap.fromList $ do+    (k, a) <- HashMap.toList m+    case HashMap.lookup k (f a) of+      Just b -> [(k,b)]+      Nothing -> []++instance Functor Complex where+  fmap f (a :+ b) = f a :+ f b+  {-# INLINE fmap #-}++instance Apply Complex where+  (a :+ b) <.> (c :+ d) = a c :+ b d++instance Applicative Complex where+  pure a = a :+ a+  (a :+ b) <*> (c :+ d) = a c :+ b d++instance Bind Complex where+  (a :+ b) >>- f = a' :+ b' where+    a' :+ _  = f a+    _  :+ b' = f b+  {-# INLINE (>>-) #-}++instance Monad Complex where+  return a = a :+ a+  {-# INLINE return #-}++  (a :+ b) >>= f = a' :+ b' where+    a' :+ _  = f a+    _  :+ b' = f b+  {-# INLINE (>>=) #-}++instance Foldable Complex where+  foldMap f (a :+ b) = f a `mappend` f b+  {-# INLINE foldMap #-}++instance Traversable Complex where+  traverse f (a :+ b) = (:+) <$> f a <*> f b+  {-# INLINE traverse #-}++instance Foldable1 Complex where+  foldMap1 f (a :+ b) = f a <> f b+  {-# INLINE foldMap1 #-}++instance Traversable1 Complex where+  traverse1 f (a :+ b) = (:+) <$> f a <.> f b+  {-# INLINE traverse1 #-}
src/Linear/Matrix.hs view
@@ -26,6 +26,7 @@ import Control.Monad (join) import Data.Distributive import Data.Foldable as Foldable+import Data.Functor.Apply import Linear.Epsilon import Linear.Metric import Linear.Quaternion@@ -37,15 +38,19 @@  -- $setup -- >>> import Data.Complex+-- >>> import Data.IntMap -- >>> import Debug.SimpleReflect.Vars  infixl 7 !*!--- | Matrix product+-- | Matrix product. This can compute mixed dense-dense, sparse-dense and sparse-sparse matrix products. -- -- >>> V2 (V3 1 2 3) (V3 4 5 6) !*! V3 (V2 1 2) (V2 3 4) (V2 4 5) -- V2 (V2 19 25) (V2 43 58)-(!*!) :: (Functor m, Foldable r, Applicative r, Distributive n, Num a) => m (r a) -> r (n a) -> m (n a)-f !*! g = fmap (\r -> Foldable.sum . liftA2 (*) r <$> g') f+--+-- >>> V2 (fromList [(1,2)]) (fromList [(2,3)]) !*! fromList [(1,V3 0 0 1), (2, V3 0 0 5)]+-- V2 (V3 0 0 2) (V3 0 0 15)+(!*!) :: (Functor m, Foldable r, Apply r, Distributive n, Num a) => m (r a) -> r (n a) -> m (n a)+f !*! g = fmap (\r -> Foldable.sum . liftF2 (*) r <$> g') f   where g' = distribute g  -- | Matrix * column vector
src/Linear/Plucker.hs view
@@ -28,7 +28,10 @@ import Control.Applicative import Data.Distributive import Data.Foldable as Foldable-import Data.Monoid+import Data.Functor.Bind+import Data.Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable import Data.Traversable import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..))@@ -37,7 +40,10 @@ import Linear.Epsilon import Linear.Metric import Linear.V4+import Linear.Vector +{-# ANN module "HLint: ignore Reduce duplication" #-}+ -- | Plücker coordinates for lines in a 3-dimensional space. data Plucker a = Plucker a a a a a a deriving (Eq,Ord,Show,Read) @@ -45,6 +51,11 @@   fmap g (Plucker a b c d e f) = Plucker (g a) (g b) (g c) (g d) (g e) (g f)   {-# INLINE fmap #-} +instance Apply Plucker where+  Plucker a b c d e f <.> Plucker g h i j k l =+    Plucker (a g) (b h) (c i) (d j) (e k) (f l)+  {-# INLINE (<.>) #-}+ instance Applicative Plucker where   pure a = Plucker a a a a a a   {-# INLINE pure #-}@@ -52,6 +63,18 @@     Plucker (a g) (b h) (c i) (d j) (e k) (f l)   {-# INLINE (<*>) #-} +instance Additive Plucker++instance Bind Plucker where+  Plucker a b c d e f >>- g = Plucker a' b' c' d' e' f' where+    Plucker a' _ _ _ _ _ = g a+    Plucker _ b' _ _ _ _ = g b+    Plucker _ _ c' _ _ _ = g c+    Plucker _ _ _ d' _ _ = g d+    Plucker _ _ _ _ e' _ = g e+    Plucker _ _ _ _ _ f' = g f+  {-# INLINE (>>-) #-}+ instance Monad Plucker where   return a = Plucker a a a a a a   {-# INLINE return #-}@@ -87,6 +110,16 @@     Plucker <$> g a <*> g b <*> g c <*> g d <*> g e <*> g f   {-# INLINE traverse #-} +instance Foldable1 Plucker where+  foldMap1 g (Plucker a b c d e f) =+    g a <> g b <> g c <> g d <> g e <> g f+  {-# INLINE foldMap1 #-}++instance Traversable1 Plucker where+  traverse1 g (Plucker a b c d e f) =+    Plucker <$> g a <.> g b <.> g c <.> g d <.> g e <.> g f+  {-# INLINE traverse1 #-}+ instance Ix a => Ix (Plucker a) where   range (Plucker l1 l2 l3 l4 l5 l6,Plucker u1 u2 u3 u4 u5 u6) =     [Plucker i1 i2 i3 i4 i5 i6 | i1 <- range (l1,u1)@@ -174,6 +207,15 @@ {-# INLINE plucker #-}  -- | These elements form a basis for the Plücker space, or the Grassmanian manifold @Gr(2,V4)@.+--+-- @+-- 'p01' :: Lens' ('Plucker' a) a+-- 'p02' :: Lens' ('Plucker' a) a+-- 'p03' :: Lens' ('Plucker' a) a+-- 'p23' :: Lens' ('Plucker' a) a+-- 'p31' :: Lens' ('Plucker' a) a+-- 'p12' :: Lens' ('Plucker' a) a+-- @ p01, p02, p03, p23, p31, p12 :: Functor f => (a -> f a) -> Plucker a -> f (Plucker a) p01 g (Plucker a b c d e f) = (\a' -> Plucker a' b c d e f) <$> g a p02 g (Plucker a b c d e f) = (\b' -> Plucker a b' c d e f) <$> g b@@ -189,6 +231,15 @@ {-# INLINE p12 #-}  -- | These elements form an alternate basis for the Plücker space, or the Grassmanian manifold @Gr(2,V4)@.+--+-- @+-- 'p10' :: 'Num' a => Lens' ('Plucker' a) a+-- 'p20' :: 'Num' a => Lens' ('Plucker' a) a+-- 'p30' :: 'Num' a => Lens' ('Plucker' a) a+-- 'p32' :: 'Num' a => Lens' ('Plucker' a) a+-- 'p13' :: 'Num' a => Lens' ('Plucker' a) a+-- 'p21' :: 'Num' a => Lens' ('Plucker' a) a+-- @ p10, p20, p30, p32, p13, p21 :: (Functor f, Num a) => (a -> f a) -> Plucker a -> f (Plucker a) p10 = anti p01 p20 = anti p02
src/Linear/Quaternion.hs view
@@ -34,6 +34,7 @@ import Data.Distributive import Data.Traversable import Data.Foldable+import Data.Functor.Bind import GHC.Arr (Ix(..)) import qualified Data.Foldable as F import Data.Monoid@@ -47,6 +48,8 @@ import Linear.Vector import Prelude hiding (any) +{-# ANN module "HLint: ignore Reduce duplication" #-}+ -- | Quaternions data Quaternion a = Quaternion a {-# UNPACK #-}!(V3 a)                     deriving (Eq,Ord,Read,Show,Data,Typeable)@@ -57,12 +60,26 @@   a <$ _ = Quaternion a (V3 a a a)   {-# INLINE (<$) #-} +instance Apply Quaternion where+  Quaternion f fv <.> Quaternion a v = Quaternion (f a) (fv <.> v)+  {-# INLINE (<.>) #-}+ instance Applicative Quaternion where   pure a = Quaternion a (pure a)   {-# INLINE pure #-}   Quaternion f fv <*> Quaternion a v = Quaternion (f a) (fv <*> v)   {-# INLINE (<*>) #-} +instance Additive Quaternion++instance Bind Quaternion where+  Quaternion a (V3 b c d) >>- f = Quaternion a' (V3 b' c' d') where+    Quaternion a' _          = f a+    Quaternion _ (V3 b' _ _) = f b+    Quaternion _ (V3 _ c' _) = f c+    Quaternion _ (V3 _ _ d') = f d+  {-# INLINE (>>-) #-}+ instance Monad Quaternion where   return = pure   {-# INLINE return #-}@@ -180,7 +197,15 @@  -- | A vector space that includes the basis elements '_e' and '_i' class Complicated t where+  -- |+  -- @+  -- '_e' :: Lens' (t a) a+  -- @   _e :: Functor f => (a -> f a) -> t a -> f (t a)+  -- |+  -- @+  -- '_i' :: Lens' (t a) a+  -- @   _i :: Functor f => (a -> f a) -> t a -> f (t a)  instance Complicated Complex where@@ -197,8 +222,20 @@  -- | A vector space that includes the basis elements '_e', '_i', '_j' and '_k' class Complicated t => Hamiltonian t where+  -- |+  -- @+  -- '_j' :: Lens' (t a) a+  -- @   _j :: Functor f => (a -> f a) -> t a -> f (t a)+  -- |+  -- @+  -- '_k' :: Lens' (t a) a+  -- @   _k :: Functor f => (a -> f a) -> t a -> f (t a)+  -- |+  -- @+  -- '_ijk' :: Lens' (t a) (V3 a)+  -- @   _ijk :: Functor f => (V3 a -> f (V3 a)) -> t a -> f (t a)  instance Hamiltonian Quaternion where
src/Linear/V2.hs view
@@ -25,13 +25,17 @@ import Data.Distributive import Data.Foldable import Data.Traversable-import Data.Monoid+import Data.Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Data.Functor.Bind import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..)) import Linear.Core import Linear.Metric import Linear.Epsilon+import Linear.Vector import Prelude hiding (sum)  -- $setup@@ -67,12 +71,32 @@   traverse f (V2 a b) = V2 <$> f a <*> f b   {-# INLINE traverse #-} +instance Foldable1 V2 where+  foldMap1 f (V2 a b) = f a <> f b+  {-# INLINE foldMap1 #-}++instance Traversable1 V2 where+  traverse1 f (V2 a b) = V2 <$> f a <.> f b+  {-# INLINE traverse1 #-}++instance Apply V2 where+  V2 a b <.> V2 d e = V2 (a d) (b e)+  {-@ INLINE (<.>) #-}+ instance Applicative V2 where   pure a = V2 a a   {-# INLINE pure #-}   V2 a b <*> V2 d e = V2 (a d) (b e)   {-@ INLINE (<*>) #-} +instance Additive V2++instance Bind V2 where+  V2 a b >>- f = V2 a' b' where+    V2 a' _ = f a+    V2 _ b' = f b+  {-# INLINE (>>-) #-}+ instance Monad V2 where   return a = V2 a a   {-# INLINE return #-}@@ -117,6 +141,10 @@   --   -- >>> V2 1 2 & _x .~ 3   -- V2 3 2+  --+  -- @+  -- '_x' :: Lens' (t a) a+  -- @   _x :: Functor f => (a -> f a) -> t a -> f (t a)   _x = _xy._x   {-# INLINE _x #-}@@ -127,11 +155,18 @@   --   -- >>> V2 1 2 & _y .~ 3   -- V2 1 3-+  --+  -- @+  -- '_y' :: Lens' (t a) a+  -- @   _y :: Functor f => (a -> f a) -> t a -> f (t a)   _y = _xy._y   {-# INLINE _y #-} +  -- |+  -- @+  -- '_xy' :: Lens' (t a) ('V2' a)+  -- @   _xy :: Functor f => (V2 a -> f (V2 a)) -> t a -> f (t a)  instance R2 V2 where
src/Linear/V3.hs view
@@ -22,8 +22,11 @@ import Data.Data import Data.Distributive import Data.Foldable+import Data.Functor.Bind import Data.Traversable-import Data.Monoid+import Data.Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..))@@ -31,7 +34,10 @@ import Linear.Epsilon import Linear.Metric import Linear.V2+import Linear.Vector +{-# ANN module "HLint: ignore Reduce duplication" #-}+ -- | A 3-dimensional vector data V3 a = V3 a a a deriving (Eq,Ord,Show,Read,Data,Typeable) @@ -49,12 +55,33 @@   traverse f (V3 a b c) = V3 <$> f a <*> f b <*> f c   {-# INLINE traverse #-} +instance Foldable1 V3 where+  foldMap1 f (V3 a b c) = f a <> f b <> f c+  {-# INLINE foldMap1 #-}++instance Traversable1 V3 where+  traverse1 f (V3 a b c) = V3 <$> f a <.> f b <.> f c+  {-# INLINE traverse1 #-}++instance Apply V3 where+  V3 a b c <.> V3 d e f = V3 (a d) (b e) (c f)+  {-# INLINE (<.>) #-}+ instance Applicative V3 where   pure a = V3 a a a   {-# INLINE pure #-}   V3 a b c <*> V3 d e f = V3 (a d) (b e) (c f)   {-# INLINE (<*>) #-} +instance Additive V3++instance Bind V3 where+  V3 a b c >>- f = V3 a' b' c' where+    V3 a' _ _ = f a+    V3 _ b' _ = f b+    V3 _ _ c' = f c+  {-# INLINE (>>-) #-}+ instance Monad V3 where   return a = V3 a a a   {-# INLINE return #-}@@ -98,7 +125,15 @@  -- | A space that distinguishes 3 orthogonal basis vectors: '_x', '_y', and '_z'. (It may have more) class R2 t => R3 t where+  -- |+  -- @+  -- '_z' :: Lens' (t a) a+  -- @   _z :: Functor f => (a -> f a) -> t a -> f (t a)+  -- |+  -- @+  -- '_xyz' :: Lens' (t a) ('V3' a)+  -- @   _xyz :: Functor f => (V3 a -> f (V3 a)) -> t a -> f (t a)  instance R2 V3 where
src/Linear/V4.hs view
@@ -23,7 +23,10 @@ import Data.Data import Data.Distributive import Data.Foldable-import Data.Monoid+import Data.Functor.Bind+import Data.Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable import Data.Traversable import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..))@@ -33,7 +36,10 @@ import Linear.Metric import Linear.V2 import Linear.V3+import Linear.Vector +{-# ANN module "HLint: ignore Reduce duplication" #-}+ -- | A 4-dimensional vector. data V4 a = V4 a a a a deriving (Eq,Ord,Show,Read,Data,Typeable) @@ -51,12 +57,34 @@   traverse f (V4 a b c d) = V4 <$> f a <*> f b <*> f c <*> f d   {-# INLINE traverse #-} +instance Foldable1 V4 where+  foldMap1 f (V4 a b c d) = f a <> f b <> f c <> f d+  {-# INLINE foldMap1 #-}++instance Traversable1 V4 where+  traverse1 f (V4 a b c d) = V4 <$> f a <.> f b <.> f c <.> f d+  {-# INLINE traverse1 #-}+ instance Applicative V4 where   pure a = V4 a a a a   {-# INLINE pure #-}   V4 a b c d <*> V4 e f g h = V4 (a e) (b f) (c g) (d h)   {-# INLINE (<*>) #-} +instance Apply V4 where+  V4 a b c d <.> V4 e f g h = V4 (a e) (b f) (c g) (d h)+  {-# INLINE (<.>) #-}++instance Additive V4++instance Bind V4 where+  V4 a b c d >>- f = V4 a' b' c' d' where+    V4 a' _ _ _ = f a+    V4 _ b' _ _ = f b+    V4 _ _ c' _ = f c+    V4 _ _ _ d' = f d+  {-# INLINE (>>-) #-}+ instance Monad V4 where   return a = V4 a a a a   {-# INLINE return #-}@@ -104,7 +132,15 @@  -- | A space that distinguishes orthogonal basis vectors '_x', '_y', '_z', '_w'. (It may have more.) class R3 t => R4 t where+  -- |+  -- @+  -- '_w' :: Lens' (t a) a+  -- @   _w :: Functor f => (a -> f a) -> t a -> f (t a)+  -- |+  -- @+  -- '_xyzw' :: Lens' (t a) ('V4' a)+  -- @   _xyzw :: Functor f => (V4 a -> f (V4 a)) -> t a -> f (t a)  instance R2 V4 where
src/Linear/Vector.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DefaultSignatures #-} ----------------------------------------------------------------------------- -- | -- Module      :  Linear.Vector@@ -10,21 +12,26 @@ -- Operations on free vector spaces. ----------------------------------------------------------------------------- module Linear.Vector-  ( (^+^)-  , gnegate-  , (^-^)+  ( Additive(..)+  , negated   , (^*)   , (*^)   , (^/)-  , lerp   , basis   , basisFor   ) where  import Control.Applicative+import Data.Complex import Data.Foldable (foldMap)+import Data.Functor.Bind+import Data.HashMap.Lazy as HashMap+import Data.Hashable+import Data.IntMap as IntMap+import Data.Map as Map import Data.Monoid (Sum(..)) import Data.Traversable (Traversable, mapAccumL)+import Linear.Instances ()  -- $setup -- >>> import Control.Lens@@ -33,29 +40,68 @@ infixl 6 ^+^, ^-^ infixl 7 ^*, *^, ^/ --- | Compute the sum of two vectors------ >>> V2 1 2 ^+^ V2 3 4--- V2 4 6-(^+^) :: (Applicative f, Num a) => f a -> f a -> f a-(^+^) = liftA2 (+)-{-# INLINE (^+^) #-}+-- | A vector is an additive group with additional structure.+class Bind f => Additive f where+  -- | The zero vector+  zero :: Num a => f a+#ifndef HLINT+  default zero :: (Applicative f, Num a) => f a+  zero = pure 0+#endif +  -- | Compute the sum of two vectors+  --+  -- >>> V2 1 2 ^+^ V2 3 4+  -- V2 4 6+  (^+^) :: Num a => f a -> f a -> f a+#ifndef HLINT+  default (^+^) :: (Applicative f, Num a) => f a -> f a -> f a+  (^+^) = liftA2 (+)+  {-# INLINE (^+^) #-}+#endif++  -- | Compute the difference between two vectors+  --+  -- >>> V2 4 5 - V2 3 1+  -- V2 1 4+  (^-^) :: Num a => f a -> f a -> f a+#ifndef HLINT+  default (^-^) :: (Applicative f, Num a) => f a -> f a -> f a+  (^-^) = liftA2 (-)+  {-# INLINE (^-^) #-}+#endif++  -- | Linearly interpolate between two vectors.+  lerp :: Num a => a -> f a -> f a -> f a+  lerp alpha u v = alpha *^ u ^+^ (1 - alpha) *^ v+  {-# INLINE lerp #-}++instance Additive IntMap where+  zero = IntMap.empty+  (^+^) = IntMap.unionWith (+)+  xs ^-^ ys = IntMap.unionWith (+) xs (negated ys)++instance Ord k => Additive (Map k) where+  zero = Map.empty+  (^+^) = Map.unionWith (+)+  xs ^-^ ys = Map.unionWith (+) xs (negated ys)++instance (Eq k, Hashable k) => Additive (HashMap k) where+  zero = HashMap.empty+  (^+^) = HashMap.unionWith (+)+  xs ^-^ ys = HashMap.unionWith (+) xs (negated ys)++instance Additive ((->) b)++instance Additive Complex+ -- | Compute the negation of a vector ----- >>> gnegate (V2 2 4)+-- >>> negated (V2 2 4) -- V2 (-2) (-4)-gnegate :: (Functor f, Num a) => f a -> f a-gnegate = fmap negate-{-# INLINE gnegate #-}---- | Compute the difference between two vectors------ >>> V2 4 5 - V2 3 1--- V2 1 4-(^-^) :: (Applicative f, Num a) => f a -> f a -> f a-(^-^) = liftA2 (-)-{-# INLINE (^-^) #-}+negated :: (Functor f, Num a) => f a -> f a+negated = fmap negate+{-# INLINE negated #-}  -- | Compute the left scalar product --@@ -78,24 +124,19 @@ f ^/ a = fmap (/a) f {-# INLINE (^/) #-} --- | Linearly interpolate between two vectors.-lerp :: (Applicative f, Num a) => a -> f a -> f a -> f a-lerp alpha u v = alpha *^ u ^+^ (1 - alpha) *^ v-{-# INLINE lerp #-}- -- @setElement i x v@ sets the @i@'th element of @v@ to @x@. setElement :: Traversable t => Int -> a -> t a -> t a setElement i x = snd . mapAccumL aux 0-  where aux j y = let j' = j + 1 +  where aux j y = let j' = j + 1                       y' = if i == j then x else y                   in j' `seq` (j', y')  -- | Produce a default basis for a vector space. If the dimensionality -- of the vector space is not statically known, see 'basisFor'. basis :: (Applicative t, Traversable t, Num a) => [t a]-basis = [ setElement k 1 zero | k <- [0..n - 1] ]-  where zero = pure 0-        n = getSum $ foldMap (const (Sum 1)) zero+basis = [ setElement k 1 z | k <- [0..n - 1] ]+  where z = pure 0+        n = getSum $ foldMap (const (Sum 1)) z  -- | Produce a default basis for a vector space from which the -- argument is drawn.