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 +2/−0
- linear.cabal +9/−3
- src/Linear.hs +1/−0
- src/Linear/Instances.hs +77/−0
- src/Linear/Matrix.hs +8/−3
- src/Linear/Plucker.hs +52/−1
- src/Linear/Quaternion.hs +37/−0
- src/Linear/V2.hs +37/−2
- src/Linear/V3.hs +36/−1
- src/Linear/V4.hs +37/−1
- src/Linear/Vector.hs +73/−32
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.