linear 1.3.1 → 1.3.1.1
raw patch · 13 files changed
+262/−34 lines, 13 files
Files
- CHANGELOG.markdown +9/−0
- linear.cabal +1/−1
- src/Linear/Affine.hs +13/−0
- src/Linear/Core.hs +15/−0
- src/Linear/Plucker.hs +21/−2
- src/Linear/Quaternion.hs +15/−1
- src/Linear/V.hs +16/−1
- src/Linear/V0.hs +15/−3
- src/Linear/V1.hs +15/−1
- src/Linear/V2.hs +15/−1
- src/Linear/V3.hs +16/−1
- src/Linear/V4.hs +15/−1
- src/Linear/Vector.hs +96/−22
CHANGELOG.markdown view
@@ -1,3 +1,12 @@+1.3.1.1+-------+* Build bugfix++1.3.1+---+* Better implementations of `basis` and `basisFor`.+* Derived Generic instances.+ 1.2 --- * Improved matrix multiplication to properly support the sparse/sparse case.
linear.cabal view
@@ -1,6 +1,6 @@ name: linear category: Math, Algebra-version: 1.3.1+version: 1.3.1.1 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE
src/Linear/Affine.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE TypeFamilies #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DeriveGeneric #-} #endif ----------------------------------------------------------------------------- -- |@@ -30,6 +31,12 @@ import Data.Traversable as Traversable import Data.Vector (Vector) import Foreign.Storable+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+import GHC.Generics (Generic)+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+import GHC.Generics (Generic1)+#endif import Linear.Core import Linear.Epsilon import Linear.Metric@@ -104,6 +111,12 @@ deriving ( Eq, Ord, Show, Read, Monad, Functor, Applicative, Foldable , Traversable, Apply, Bind, Additive, Metric, Core, R1, R2, R3, R4 , Fractional , Num, Ix, Storable, Epsilon+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+ , Generic+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+ , Generic1+#endif ) instance Additive f => Affine (Point f) where
src/Linear/Core.hs view
@@ -1,4 +1,8 @@ {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE DeriveGeneric #-}+#endif ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2012-2013 Edward Kmett,@@ -16,6 +20,12 @@ ) where import Control.Applicative+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+import GHC.Generics (Generic)+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+import GHC.Generics (Generic1)+#endif -- | -- A 'Functor' @f@ is corepresentable if it is isomorphic to @(x -> a)@@@ -32,6 +42,11 @@ core :: ((forall g x. Functor g => (x -> g x) -> f x -> g (f x)) -> a) -> f a data Context a b t = Context { peek :: b -> t, pos :: a }+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+ deriving (Generic, Generic1)+#elif defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+ deriving (Generic)+#endif instance Functor (Context a b) where fmap f (Context bt a) = Context (f.bt) a
src/Linear/Plucker.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE GADTs #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DeriveGeneric #-} #endif ----------------------------------------------------------------------------- -- |@@ -49,6 +50,13 @@ import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..))+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+import GHC.Generics (Generic)+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+import GHC.Generics (Generic1)+#endif+ import Linear.Core import Linear.Epsilon import Linear.Metric@@ -60,7 +68,14 @@ {-# 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)+data Plucker a = Plucker !a !a !a !a !a !a deriving (Eq,Ord,Show,Read+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+ ,Generic+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+ ,Generic1+#endif+ ) instance Functor Plucker where fmap g (Plucker a b c d e f) = Plucker (g a) (g b) (g c) (g d) (g e) (g f)@@ -329,7 +344,11 @@ | Counterclockwise -- ^ The lines pass each other counterclockwise -- (left-handed screw).- deriving (Eq, Show)+ deriving (Eq, Show+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+ ,Generic+#endif+ ) -- | Check how two lines pass each other. @passes l1 l2@ describes -- @l2@ when looking down @l1@.
src/Linear/Quaternion.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DeriveGeneric #-} #endif ----------------------------------------------------------------------------- -- |@@ -43,6 +44,12 @@ import Data.Monoid import Foreign.Ptr (castPtr, plusPtr) import Foreign.Storable (Storable(..))+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+import GHC.Generics (Generic)+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+import GHC.Generics (Generic1)+#endif import Linear.Core import Linear.Epsilon import Linear.Conjugate@@ -55,7 +62,14 @@ -- | Quaternions data Quaternion a = Quaternion !a {-# UNPACK #-}!(V3 a)- deriving (Eq,Ord,Read,Show,Data,Typeable)+ deriving (Eq,Ord,Read,Show,Data,Typeable+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+ ,Generic+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+ ,Generic1+#endif+ ) instance Functor Quaternion where fmap f (Quaternion e v) = Quaternion (f e) (fmap f v)
src/Linear/V.hs view
@@ -11,6 +11,7 @@ #endif #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DeriveGeneric #-} #endif ----------------------------------------------------------------------------- -- |@@ -47,6 +48,12 @@ #ifdef USE_TYPE_LITS import GHC.TypeLits #endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+import GHC.Generics (Generic)+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707+import GHC.Generics (Generic1)+#endif #if !(MIN_VERSION_reflection(1,3,0)) import Language.Haskell.TH #endif@@ -58,7 +65,15 @@ class Dim n where reflectDim :: p n -> Int -newtype V n a = V { toVector :: V.Vector a } deriving (Eq,Ord,Show,Read)+newtype V n a = V { toVector :: V.Vector a } deriving (Eq,Ord,Show,Read+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+ ,Generic+#endif+-- GHC bug: https://ghc.haskell.org/trac/ghc/ticket/8468+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707+ ,Generic1+#endif+ ) dim :: forall n a. Dim n => V n a -> Int dim _ = reflectDim (Proxy :: Proxy n)
src/Linear/V0.hs view
@@ -1,9 +1,9 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE Trustworthy #-} #endif -----------------------------------------------------------------------------@@ -29,7 +29,12 @@ import Data.Traversable import Data.Semigroup import Data.Functor.Bind-import GHC.Generics+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+import GHC.Generics (Generic)+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+import GHC.Generics (Generic1)+#endif import Foreign.Storable (Storable(..)) import Linear.Core import Linear.Metric@@ -48,7 +53,14 @@ -- >>> V0 + V0 -- V0 ---data V0 a = V0 deriving (Eq,Ord,Show,Read,Ix,Enum,Data,Typeable,Generic)+data V0 a = V0 deriving (Eq,Ord,Show,Read,Ix,Enum,Data,Typeable+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+ ,Generic+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+ ,Generic1+#endif+ ) instance Functor V0 where fmap _ V0 = V0
src/Linear/V1.hs view
@@ -9,6 +9,7 @@ {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DeriveGeneric #-} #endif ----------------------------------------------------------------------------- -- |@@ -37,6 +38,12 @@ import Data.Functor.Bind import Foreign.Storable (Storable) import GHC.Arr (Ix(..))+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+import GHC.Generics (Generic)+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+import GHC.Generics (Generic1)+#endif import Linear.Core import Linear.Metric import Linear.Epsilon@@ -64,7 +71,14 @@ newtype V1 a = V1 a deriving (Eq,Ord,Show,Read,Data,Typeable, Functor,Foldable,Traversable,- Epsilon,Storable)+ Epsilon,Storable+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+ ,Generic+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+ ,Generic1+#endif+ ) instance Foldable1 V1 where foldMap1 f (V1 a) = f a
src/Linear/V2.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DeriveGeneric #-} #endif ----------------------------------------------------------------------------- -- |@@ -36,6 +37,12 @@ import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..))+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+import GHC.Generics (Generic)+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+import GHC.Generics (Generic1)+#endif import Linear.Core import Linear.Metric import Linear.Epsilon@@ -60,7 +67,14 @@ -- >>> sum (V2 1 2) -- 3 -data V2 a = V2 !a !a deriving (Eq,Ord,Show,Read,Data,Typeable)+data V2 a = V2 !a !a deriving (Eq,Ord,Show,Read,Data,Typeable+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+ ,Generic+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+ ,Generic1+#endif+ ) instance Functor V2 where fmap f (V2 a b) = V2 (f a) (f b)
src/Linear/V3.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DeriveGeneric #-} #endif ----------------------------------------------------------------------------- -- |@@ -34,6 +35,12 @@ import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..))+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+import GHC.Generics (Generic)+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+import GHC.Generics (Generic1)+#endif import Linear.Core import Linear.Epsilon import Linear.Metric@@ -43,7 +50,15 @@ {-# ANN module "HLint: ignore Reduce duplication" #-} -- | A 3-dimensional vector-data V3 a = V3 !a !a !a deriving (Eq,Ord,Show,Read,Data,Typeable)+data V3 a = V3 !a !a !a deriving (Eq,Ord,Show,Read,Data,Typeable+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+ ,Generic+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+ ,Generic1+#endif+ )+ instance Functor V3 where fmap f (V3 a b c) = V3 (f a) (f b) (f c)
src/Linear/V4.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DeriveGeneric #-} #endif ----------------------------------------------------------------------------- -- |@@ -35,6 +36,12 @@ import Foreign.Ptr (castPtr) import Foreign.Storable (Storable(..)) import GHC.Arr (Ix(..))+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+import GHC.Generics (Generic)+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+import GHC.Generics (Generic1)+#endif import Linear.Core import Linear.Epsilon import Linear.Metric@@ -45,7 +52,14 @@ {-# 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)+data V4 a = V4 !a !a !a !a deriving (Eq,Ord,Show,Read,Data,Typeable+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+ ,Generic+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+ ,Generic1+#endif+ ) instance Functor V4 where fmap f (V4 a b c d) = V4 (f a) (f b) (f c) (f d)
src/Linear/Vector.hs view
@@ -1,10 +1,11 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DefaultSignatures #-}+#define USE_GHC_GENERICS #endif ----------------------------------------------------------------------------- -- |@@ -31,17 +32,19 @@ import Control.Applicative import Data.Complex-import Data.Foldable as Foldable (Foldable, foldMap, forM_, foldl')+import Data.Foldable as Foldable (Foldable, forM_, foldl') import Data.Functor.Identity import Data.HashMap.Lazy as HashMap import Data.Hashable import Data.IntMap as IntMap import Data.Map as Map-import Data.Monoid (Sum(..), mempty)+import Data.Monoid (mempty) import Data.Vector as Vector import Data.Vector.Mutable as Mutable-import Data.Traversable (Traversable, mapAccumL)+import Data.Traversable (Traversable, traverse, mapAccumL)+#ifdef USE_GHC_GENERICS import GHC.Generics+#endif import Linear.Instances () -- $setup@@ -51,6 +54,7 @@ infixl 6 ^+^, ^-^ infixl 7 ^*, *^, ^/ +#ifdef USE_GHC_GENERICS class GAdditive f where gzero :: Num a => f a gliftU2 :: (a -> a -> a) -> f a -> f a -> f a@@ -94,38 +98,45 @@ {-# INLINE gliftU2 #-} gliftI2 f (Par1 a) (Par1 b) = Par1 (f a b) {-# INLINE gliftI2 #-}+#endif -- | A vector is an additive group with additional structure. class Functor f => Additive f where -- | The zero vector zero :: Num a => f a+#ifdef USE_GHC_GENERICS #ifndef HLINT default zero :: (GAdditive (Rep1 f), Generic1 f, Num a) => f a zero = to1 gzero #endif+#endif -- | Compute the sum of two vectors -- -- >>> V2 1 2 ^+^ V2 3 4 -- V2 4 6 (^+^) :: Num a => f a -> f a -> f a+#ifdef USE_GHC_GENERICS #ifndef HLINT default (^+^) :: Num a => f a -> f a -> f a (^+^) = liftU2 (+) {-# INLINE (^+^) #-} #endif+#endif -- | Compute the difference between two vectors -- -- >>> V2 4 5 - V2 3 1 -- V2 1 4 (^-^) :: Num a => f a -> f a -> f a+#ifdef USE_GHC_GENERICS #ifndef HLINT default (^-^) :: Num a => f a -> f a -> f a x ^-^ y = x ^+^ negated y {-# INLINE (^-^) #-} #endif+#endif -- | Linearly interpolate between two vectors. lerp :: Num a => a -> f a -> f a -> f a@@ -138,11 +149,13 @@ -- -- * For a sparse vector this is equivalent to 'unionWith'. liftU2 :: (a -> a -> a) -> f a -> f a -> f a+#ifdef USE_GHC_GENERICS #ifndef HLINT default liftU2 :: Applicative f => (a -> a -> a) -> f a -> f a -> f a liftU2 = liftA2 {-# INLINE liftU2 #-} #endif+#endif -- | Apply a function to the components of two vectors. --@@ -150,11 +163,13 @@ -- -- * For a sparse vector this is equivalent to 'intersectionWith'. liftI2 :: (a -> b -> c) -> f a -> f b -> f c+#ifdef USE_GHC_GENERICS #ifndef HLINT default liftI2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c liftI2 = liftA2 {-# INLINE liftI2 #-} #endif+#endif instance Additive ZipList where zero = ZipList []@@ -163,6 +178,12 @@ {-# INLINE liftU2 #-} liftI2 = liftA2 {-# INLINE liftI2 #-}+#ifndef USE_GHC_GENERICS+ (^+^) = liftU2 (+)+ {-# INLINE (^+^) #-}+ x ^-^ y = x ^+^ negated y+ {-# INLINE (^-^) #-}+#endif instance Additive Vector where zero = mempty@@ -179,6 +200,12 @@ {-# INLINE liftU2 #-} liftI2 = Vector.zipWith {-# INLINE liftI2 #-}+#ifndef USE_GHC_GENERICS+ (^+^) = liftU2 (+)+ {-# INLINE (^+^) #-}+ x ^-^ y = x ^+^ negated y+ {-# INLINE (^-^) #-}+#endif instance Additive Maybe where zero = Nothing@@ -189,6 +216,12 @@ {-# INLINE liftU2 #-} liftI2 = liftA2 {-# INLINE liftI2 #-}+#ifndef USE_GHC_GENERICS+ (^+^) = liftU2 (+)+ {-# INLINE (^+^) #-}+ x ^-^ y = x ^+^ negated y+ {-# INLINE (^-^) #-}+#endif instance Additive [] where zero = []@@ -200,6 +233,12 @@ {-# INLINE liftU2 #-} liftI2 = Prelude.zipWith {-# INLINE liftI2 #-}+#ifndef USE_GHC_GENERICS+ (^+^) = liftU2 (+)+ {-# INLINE (^+^) #-}+ x ^-^ y = x ^+^ negated y+ {-# INLINE (^-^) #-}+#endif instance Additive IntMap where zero = IntMap.empty@@ -208,6 +247,12 @@ {-# INLINE liftU2 #-} liftI2 = IntMap.intersectionWith {-# INLINE liftI2 #-}+#ifndef USE_GHC_GENERICS+ (^+^) = liftU2 (+)+ {-# INLINE (^+^) #-}+ x ^-^ y = x ^+^ negated y+ {-# INLINE (^-^) #-}+#endif instance Ord k => Additive (Map k) where zero = Map.empty@@ -216,6 +261,12 @@ {-# INLINE liftU2 #-} liftI2 = Map.intersectionWith {-# INLINE liftI2 #-}+#ifndef USE_GHC_GENERICS+ (^+^) = liftU2 (+)+ {-# INLINE (^+^) #-}+ x ^-^ y = x ^+^ negated y+ {-# INLINE (^-^) #-}+#endif instance (Eq k, Hashable k) => Additive (HashMap k) where zero = HashMap.empty@@ -224,6 +275,12 @@ {-# INLINE liftU2 #-} liftI2 = HashMap.intersectionWith {-# INLINE liftI2 #-}+#ifndef USE_GHC_GENERICS+ (^+^) = liftU2 (+)+ {-# INLINE (^+^) #-}+ x ^-^ y = x ^+^ negated y+ {-# INLINE (^-^) #-}+#endif instance Additive ((->) b) where zero = const 0@@ -232,6 +289,12 @@ {-# INLINE liftU2 #-} liftI2 = liftA2 {-# INLINE liftI2 #-}+#ifndef USE_GHC_GENERICS+ (^+^) = liftU2 (+)+ {-# INLINE (^+^) #-}+ x ^-^ y = x ^+^ negated y+ {-# INLINE (^-^) #-}+#endif instance Additive Complex where zero = 0 :+ 0@@ -240,6 +303,12 @@ {-# INLINE liftU2 #-} liftI2 f (a :+ b) (c :+ d) = f a c :+ f b d {-# INLINE liftI2 #-}+#ifndef USE_GHC_GENERICS+ (^+^) = liftU2 (+)+ {-# INLINE (^+^) #-}+ x ^-^ y = x ^+^ negated y+ {-# INLINE (^-^) #-}+#endif instance Additive Identity where zero = Identity 0@@ -248,6 +317,12 @@ {-# INLINE liftU2 #-} liftI2 = liftA2 {-# INLINE liftI2 #-}+#ifndef USE_GHC_GENERICS+ (^+^) = liftU2 (+)+ {-# INLINE (^+^) #-}+ x ^-^ y = x ^+^ negated y+ {-# INLINE (^-^) #-}+#endif -- | Compute the negation of a vector --@@ -286,33 +361,32 @@ f ^/ a = fmap (/a) f {-# INLINE (^/) #-} --- @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- y' = if i == j then x else y- in j' `seq` (j', y')+-- `SetOne` builds all combinations of the filler with one value from the choices list.+data SetOne a = SetOne { _filler :: !a, choices :: [a] }+instance Functor SetOne where+ fmap f (SetOne a os) = SetOne (f a) (fmap f os)+instance Applicative SetOne where+ pure a = SetOne a []+ SetOne f fs <*> SetOne a as = SetOne (f a) (Prelude.foldr ((:) . ($ a)) (Prelude.map f as) fs) -- | 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 z | k <- [0..n - 1] ]- where z = pure 0- n = getSum $ foldMap (const (Sum 1)) z+basis = choices $ traverse (\a -> SetOne 0 [a]) (pure 1) -- | Produce a default basis for a vector space from which the -- argument is drawn.-basisFor :: (Traversable t, Enum a, Num a) => t a -> [t a]-basisFor v = [ setElement k 1 z | k <- [0..n-1] ]- where z = 0 <$ v- n = getSum $ foldMap (const (Sum 1)) v+basisFor :: (Traversable t, Num a) => t b -> [t a]+basisFor = choices . traverse (\_ -> SetOne 0 [1]) -- | Produce a diagonal matrix from a vector.-kronecker :: (Applicative t, Num a, Traversable t) => t a -> t (t a)-kronecker v = snd $ mapAccumL aux 0 v- where aux i e = let i' = i + 1- in i' `seq` (i', setElement i e z)- z = pure 0+kronecker :: (Traversable t, Num a) => t a -> t (t a)+kronecker v = fillFromList (choices $ traverse (\a -> SetOne 0 [a]) v) v++fillFromList :: Traversable t => [a] -> t b -> t a+fillFromList l = snd . mapAccumL aux l+ where aux (a:as) _ = (as, a)+ aux [] _ = error "too few elements in takeFromList" -- | Outer (tensor) product of two vectors outer :: (Functor f, Functor g, Num a) => f a -> g a -> f (g a)