linear 1.0.1 → 1.1.1

raw patch · 12 files changed

+468/−33 lines, 12 filesdep +ghc-primdep +reflectiondep +taggeddep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim, reflection, tagged, template-haskell, vector

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +9/−1
• linear.cabal +8/−2
• src/Linear/Matrix.hs +12/−7
• src/Linear/Metric.hs +5/−2
• src/Linear/Plucker.hs +7/−1
• src/Linear/Quaternion.hs +7/−1
• src/Linear/V.hs +230/−0
• src/Linear/V0.hs +11/−3
• src/Linear/V2.hs +7/−1
• src/Linear/V3.hs +7/−1
• src/Linear/V4.hs +7/−1
• src/Linear/Vector.hs +158/−13

@@ -1,8 +1,16 @@+1.1.1+-----+* Fixed an infinite loop in the default definition of `liftI2`.++1.1+---+* Added `Additive` instances for `[]`, `Maybe` and `Vector`.+ 1.0 --- * Strict vectors * Exported `mkTransformationMat`-* Bumped dependency bounds.+* Bumped dependency bounds  0.9.1 [bug fix] -----

@@ -1,6 +1,6 @@ name:          linear category:      Math, Algebra-version:       1.0.1+version:       1.1.1 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -33,11 +33,16 @@     base                 >= 4.5   && < 5,     containers           >= 0.4   && < 0.6,     distributive         >= 0.2.2 && < 1,+    ghc-prim,     hashable             >= 1.1   && < 1.3,+    reflection           >= 1.1.6 && < 2,     semigroups           >= 0.9   && < 1,     semigroupoids        >= 3     && < 4,+    tagged               >= 0.4.4 && < 1,+    template-haskell     >= 2.7   && < 3.0,     transformers         >= 0.2   && < 0.4,-    unordered-containers >= 0.2.3 && < 0.3+    unordered-containers >= 0.2.3 && < 0.3,+    vector               >= 0.10  && < 0.11    exposed-modules:     Linear@@ -49,6 +54,7 @@     Linear.Metric     Linear.Plucker     Linear.Quaternion+    Linear.V     Linear.V0     Linear.V2     Linear.V3

@@ -15,7 +15,7 @@   , adjoint   , M22, M33, M44, M43, m33_to_m44, m43_to_m44   , det22, det33, inv22, inv33-  , eye3, eye4+  , eye2, eye3, eye4   , trace   , translation   , fromQuaternion@@ -27,14 +27,13 @@ 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 import Linear.V2 import Linear.V3 import Linear.V4-import Linear.Vector ((*^), Additive, liftU2, (^+^), (^-^))+import Linear.Vector import Linear.Conjugate  -- $setup@@ -50,9 +49,8 @@ -- -- >>> 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+(!*!) :: (Functor m, Foldable r, Additive r, Distributive n, Num a) => m (r a) -> r (n a) -> m (n a)+f !*! g = fmap (\r -> Foldable.sum . liftI2 (*) r <$> g') f where g' = distribute g  infixl 6 !+! -- | Entry-wise matrix addition.@@ -173,6 +171,14 @@ m33_to_m44 (V3 r1 r2 r3) = V4 (vector r1) (vector r2) (vector r3) (point 0) {-# ANN m33_to_m44 "HLint: ignore Use camelCase" #-} +-- |2x2 identity matrix.+--+-- >>> eye2+-- V2 (V2 1 0) (V2 0 1)+eye2 :: Num a => M22 a+eye2 = V2 (V2 1 0)+          (V2 0 1)+ -- |3x3 identity matrix. -- -- >>> eye3@@ -191,7 +197,6 @@           (V4 0 1 0 0)           (V4 0 0 1 0)           (V4 0 0 0 1)-  -- |Extract the translation vector (first three entries of the last -- column) from a 3x4 or 4x4 matrix

@@ -17,7 +17,7 @@   ) where  import Data.Foldable as Foldable-import Data.Functor.Apply+import Data.Functor.Identity import Linear.Epsilon import Linear.Vector @@ -34,7 +34,7 @@   dot :: Num a => f a -> f a -> a #ifndef HLINT   default dot :: (Foldable f, Num a) => f a -> f a -> a-  dot x y = Foldable.sum $ liftF2 (*) x y+  dot x y = Foldable.sum $ liftI2 (*) x y #endif    -- | Compute the squared norm. The name quadrance arises from@@ -58,6 +58,9 @@   signorm :: Floating a => f a -> f a   signorm v = fmap (/m) v where     m = norm v++instance Metric Identity where+  dot (Identity x) (Identity y) = x * y  -- | Normalize a 'Metric' functor to have unit 'norm'. This function -- does not change the functor if its 'norm' is 0 or 1.

@@ -63,7 +63,13 @@     Plucker (a g) (b h) (c i) (d j) (e k) (f l)   {-# INLINE (<*>) #-} -instance Additive Plucker+instance Additive Plucker where+  zero = pure 0+  {-# INLINE zero #-}+  liftU2 = liftA2+  {-# INLINE liftU2 #-}+  liftI2 = liftA2+  {-# INLINE liftI2 #-}  instance Bind Plucker where   Plucker a b c d e f >>- g = Plucker a' b' c' d' e' f' where

@@ -70,7 +70,13 @@   Quaternion f fv <*> Quaternion a v = Quaternion (f a) (fv <*> v)   {-# INLINE (<*>) #-} -instance Additive Quaternion+instance Additive Quaternion where+  zero = pure 0+  {-# INLINE zero #-}+  liftU2 = liftA2+  {-# INLINE liftU2 #-}+  liftI2 = liftA2+  {-# INLINE liftI2 #-}  instance Bind Quaternion where   Quaternion a (V3 b c d) >>- f = Quaternion a' (V3 b' c' d') where

@@ -0,0 +1,230 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds, KindSignatures, ScopedTypeVariables, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+#define USE_TYPE_LITS 1+#endif++module Linear.V+  ( V(toVector)+  , int+  , dim+  , Dim(..)+  , reifyDim+  , reifyVector+  , fromVector+  ) where++import Control.Applicative+import Data.Distributive+import Data.Foldable as Foldable+import Data.Functor.Bind+import Data.Proxy+import Data.Reflection as R+import Data.Traversable+import Data.Vector as V+import Foreign.Ptr+import Foreign.Storable+#ifdef USE_TYPE_LITS+import GHC.TypeLits+#endif+import Language.Haskell.TH+import Linear.Core+import Linear.Epsilon+import Linear.Metric+import Linear.Vector++class Dim n where+  reflectDim :: p n -> Int++newtype V n a = V { toVector :: V.Vector a } deriving (Eq,Ord,Show,Read)++dim :: forall n a. Dim n => V n a -> Int+dim _ = reflectDim (Proxy :: Proxy n)+{-# INLINE dim #-}++#ifdef USE_TYPE_LITS+instance SingRep n Integer => Dim (n :: Nat) where+  reflectDim _ = fromInteger $ withSing $ \(x :: Sing n) -> fromSing x+  {-# INLINE reflectDim #-}+#endif++data ReifiedDim (s :: *)++retagDim :: (Proxy s -> a) -> proxy (ReifiedDim s) -> a+retagDim f _ = f Proxy+{-# INLINE retagDim #-}++instance Reifies s Int => Dim (ReifiedDim s) where+  reflectDim = retagDim reflect+  {-# INLINE reflectDim #-}++reifyDim :: Int -> (forall (n :: *). Dim n => Proxy n -> r) -> r+reifyDim i f = R.reify i (go f) where+  go :: Reifies n Int => (Proxy (ReifiedDim n) -> a) -> proxy n -> a+  go g _ = g Proxy+{-# INLINE reifyDim #-}++reifyVector :: forall a r. Vector a -> (forall (n :: *). Dim n => V n a -> r) -> r+reifyVector v f = reifyDim (V.length v) $ \(Proxy :: Proxy n) -> f (V v :: V n a)+{-# INLINE reifyVector #-}++instance Dim n => Dim (V n a) where+  reflectDim _ = reflectDim (Proxy :: Proxy n)+  {-# INLINE reflectDim #-}++instance Functor (V n) where+  fmap f (V as) = V (fmap f as)+  {-# INLINE fmap #-}++instance Foldable (V n) where+  foldMap f (V as) = foldMap f as+  {-# INLINE foldMap #-}++instance Traversable (V n) where+  traverse f (V as) = V <$> traverse f as+  {-# INLINE traverse #-}++instance Apply (V n) where+  V as <.> V bs = V (V.zipWith id as bs)+  {-# INLINE (<.>) #-}++instance Dim n => Applicative (V n) where+  pure = V . V.replicate (reflectDim (Proxy :: Proxy n))+  {-# INLINE pure #-}++  V as <*> V bs = V (V.zipWith id as bs)+  {-# INLINE (<*>) #-}++instance Bind (V n) where+  V as >>- f = V $ generate (V.length as) $ \i ->+    toVector (f (as `unsafeIndex` i)) `unsafeIndex` i+  {-# INLINE (>>-) #-}++instance Dim n => Monad (V n) where+  return = V . V.replicate (reflectDim (Proxy :: Proxy n))+  {-# INLINE return #-}+  V as >>= f = V $ generate (reflectDim (Proxy :: Proxy n)) $ \i ->+    toVector (f (as `unsafeIndex` i)) `unsafeIndex` i+  {-# INLINE (>>=) #-}++instance Dim n => Additive (V n) where+  zero = pure 0+  {-# INLINE zero #-}+  liftU2 f (V as) (V bs) = V (V.zipWith f as bs)+  {-# INLINE liftU2 #-}+  liftI2 f (V as) (V bs) = V (V.zipWith f as bs)+  {-# INLINE liftI2 #-}++instance (Dim n, Num a) => Num (V n a) where+  V as + V bs = V $ V.zipWith (+) as bs+  {-# INLINE (+) #-}+  V as - V bs = V $ V.zipWith (-) as bs+  {-# INLINE (-) #-}+  V as * V bs = V $ V.zipWith (*) as bs+  {-# INLINE (*) #-}+  negate = fmap negate+  {-# INLINE negate #-}+  abs = fmap abs+  {-# INLINE abs #-}+  signum = fmap signum+  {-# INLINE signum #-}+  fromInteger = pure . fromInteger+  {-# INLINE fromInteger #-}++instance (Dim n, Fractional a) => Fractional (V n a) where+  recip = fmap recip+  {-# INLINE recip #-}+  V as / V bs = V $ V.zipWith (/) as bs+  {-# INLINE (/) #-}+  fromRational = pure . fromRational+  {-# INLINE fromRational #-}++instance Dim n => Core (V n) where+  core f = V $ generate (reflectDim (Proxy :: Proxy n)) $ \i -> f $ \g (V v) ->+    (\a -> V $ v V.// [(i,a)]) <$> g (unsafeIndex v i)+  {-# INLINE core #-}++instance Dim n => Distributive (V n) where+  distribute f = V $ V.generate (reflectDim (Proxy :: Proxy n)) $ \i -> fmap (\(V v) -> unsafeIndex v i) f+  {-# INLINE distribute #-}++instance (Dim n, Storable a) => Storable (V n a) where+  sizeOf _ = reflectDim (Proxy :: Proxy n) * sizeOf (undefined:: a)+  {-# INLINE sizeOf #-}+  alignment _ = alignment (undefined :: a)+  {-# INLINE alignment #-}+  poke ptr (V xs) = Foldable.forM_ [0..reflectDim (Proxy :: Proxy n)-1] $ \i ->+    pokeElemOff ptr' i (unsafeIndex xs i)+    where ptr' = castPtr ptr+  {-# INLINE poke #-}+  peek ptr = V <$> generateM (reflectDim (Proxy :: Proxy n)) (peekElemOff ptr')+    where ptr' = castPtr ptr+  {-# INLINE peek #-}++instance (Dim n, Epsilon a) => Epsilon (V n a) where+  nearZero = nearZero . quadrance+  {-# INLINE nearZero #-}++instance Dim n => Metric (V n) where+  dot (V a) (V b) = V.sum $ V.zipWith (*) a b+  {-# INLINE dot #-}++-- TODO: instance (Dim n, Ix a) => Ix (V n a)++fromVector :: forall n a. Dim n => Vector a -> Maybe (V n a)+fromVector v+  | V.length v == reflectDim (Proxy :: Proxy n) = Just (V v)+  | otherwise                                   = Nothing++data Z  -- 0+data D  (n :: *) -- 2n+data SD (n :: *) -- 2n+1+data PD (n :: *) -- 2n-1++instance Reifies Z Int where+  reflect _ = 0+  {-# INLINE reflect #-}++retagD :: (Proxy n -> a) -> proxy (D n) -> a+retagD f _ = f Proxy+{-# INLINE retagD #-}++retagSD :: (Proxy n -> a) -> proxy (SD n) -> a+retagSD f _ = f Proxy+{-# INLINE retagSD #-}++retagPD :: (Proxy n -> a) -> proxy (PD n) -> a+retagPD f _ = f Proxy+{-# INLINE retagPD #-}++instance Reifies n Int => Reifies (D n) Int where+  reflect = (\n -> n+n) <$> retagD reflect+  {-# INLINE reflect #-}++instance Reifies n Int => Reifies (SD n) Int where+  reflect = (\n -> n+n+1) <$> retagSD reflect+  {-# INLINE reflect #-}++instance Reifies n Int => Reifies (PD n) Int where+  reflect = (\n -> n+n-1) <$> retagPD reflect+  {-# INLINE reflect #-}++-- | This can be used to generate a template haskell splice for a type level version of a given 'int'.+--+-- This does not use GHC TypeLits, instead it generates a numeric type by hand similar to the ones used+-- in the \"Functional Pearl: Implicit Dimurations\" paper by Oleg Kiselyov and Chung-Chieh Shan.+int :: Int -> TypeQ+int n = case quotRem n 2 of+  (0, 0) -> conT ''Z+  (q,-1) -> conT ''PD `appT` int q+  (q, 0) -> conT ''D  `appT` int q+  (q, 1) -> conT ''SD `appT` int q+  _     -> error "ghc is bad at math"++

@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- Module      :  Linear.V0@@ -25,6 +26,7 @@ import Data.Traversable import Data.Semigroup import Data.Functor.Bind+import GHC.Generics import Foreign.Storable (Storable(..)) import Linear.Core import Linear.Metric@@ -43,7 +45,7 @@ -- >>> V0 + V0 -- V0 ---data V0 a = V0 deriving (Eq,Ord,Show,Read,Ix,Enum,Data,Typeable)+data V0 a = V0 deriving (Eq,Ord,Show,Read,Ix,Enum,Data,Typeable,Generic)  instance Functor V0 where   fmap _ V0 = V0@@ -67,9 +69,15 @@   pure _ = V0   {-# INLINE pure #-}   V0 <*> V0 = V0-  {-@ INLINE (<*>) #-}+  {-# INLINE (<*>) #-} -instance Additive V0+instance Additive V0 where+  zero = V0+  {-# INLINE zero #-}+  liftU2 _ V0 V0 = V0+  {-# INLINE liftU2 #-}+  liftI2 _ V0 V0 = V0+  {-# INLINE liftI2 #-}  instance Bind V0 where   V0 >>- _ = V0

@@ -89,7 +89,13 @@   V2 a b <*> V2 d e = V2 (a d) (b e)   {-@ INLINE (<*>) #-} -instance Additive V2+instance Additive V2 where+  zero = pure 0+  {-# INLINE zero #-}+  liftU2 = liftA2+  {-# INLINE liftU2 #-}+  liftI2 = liftA2+  {-# INLINE liftI2 #-}  instance Bind V2 where   V2 a b >>- f = V2 a' b' where

@@ -73,7 +73,13 @@   V3 a b c <*> V3 d e f = V3 (a d) (b e) (c f)   {-# INLINE (<*>) #-} -instance Additive V3+instance Additive V3 where+  zero = pure 0+  {-# INLINE zero #-}+  liftU2 = liftA2+  {-# INLINE liftU2 #-}+  liftI2 = liftA2+  {-# INLINE liftI2 #-}  instance Bind V3 where   V3 a b c >>- f = V3 a' b' c' where

@@ -75,7 +75,13 @@   V4 a b c d <.> V4 e f g h = V4 (a e) (b f) (c g) (d h)   {-# INLINE (<.>) #-} -instance Additive V4+instance Additive V4 where+  zero = pure 0+  {-# INLINE zero #-}+  liftU2 = liftA2+  {-# INLINE liftU2 #-}+  liftI2 = liftA2+  {-# INLINE liftI2 #-}  instance Bind V4 where   V4 a b c d >>- f = V4 a' b' c' d' where

@@ -1,5 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-} ----------------------------------------------------------------------------- -- | -- Module      :  Linear.Vector@@ -19,19 +22,22 @@   , (^/)   , basis   , basisFor+  , kronecker   ) where  import Control.Applicative import Data.Complex-import Data.Foldable (foldMap)-import Data.Functor.Bind+import Data.Foldable as Foldable (foldMap, forM_) 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(..))+import Data.Monoid (Sum(..), mempty)+import Data.Vector as Vector+import Data.Vector.Mutable as Mutable import Data.Traversable (Traversable, mapAccumL)+import GHC.Generics import Linear.Instances ()  -- $setup@@ -41,13 +47,58 @@ infixl 6 ^+^, ^-^ infixl 7 ^*, *^, ^/ +class GAdditive f where+  gzero :: Num a => f a+  gliftU2 :: (a -> a -> a) -> f a -> f a -> f a+  gliftI2 :: (a -> b -> c) -> f a -> f b -> f c++instance GAdditive U1 where+  gzero = U1+  {-# INLINE gzero #-}+  gliftU2 _ U1 U1 = U1+  {-# INLINE gliftU2 #-}+  gliftI2 _ U1 U1 = U1+  {-# INLINE gliftI2 #-}++instance (GAdditive f, GAdditive g) => GAdditive (f :*: g) where+  gzero = gzero :*: gzero+  {-# INLINE gzero #-}+  gliftU2 f (a :*: b) (c :*: d) = gliftU2 f a c :*: gliftU2 f b d+  {-# INLINE gliftU2 #-}+  gliftI2 f (a :*: b) (c :*: d) = gliftI2 f a c :*: gliftI2 f b d+  {-# INLINE gliftI2 #-}++instance Additive f => GAdditive (Rec1 f) where+  gzero = Rec1 zero+  {-# INLINE gzero #-}+  gliftU2 f (Rec1 g) (Rec1 h) = Rec1 (liftU2 f g h)+  {-# INLINE gliftU2 #-}+  gliftI2 f (Rec1 g) (Rec1 h) = Rec1 (liftI2 f g h)+  {-# INLINE gliftI2 #-}++instance GAdditive f => GAdditive (M1 i c f) where+  gzero = M1 gzero+  {-# INLINE gzero #-}+  gliftU2 f (M1 g) (M1 h) = M1 (gliftU2 f g h)+  {-# INLINE gliftU2 #-}+  gliftI2 f (M1 g) (M1 h) = M1 (gliftI2 f g h)+  {-# INLINE gliftI2 #-}++instance GAdditive Par1 where+  gzero = Par1 0+  gliftU2 f (Par1 a) (Par1 b) = Par1 (f a b)+  {-# INLINE gliftU2 #-}+  gliftI2 f (Par1 a) (Par1 b) = Par1 (f a b)+  {-# INLINE gliftI2 #-}++ -- | A vector is an additive group with additional structure.-class Bind f => Additive f where+class Functor 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+  default zero :: (GAdditive (Rep1 f), Generic1 f, Num a) => f a+  zero = to1 gzero #endif    -- | Compute the sum of two vectors@@ -56,7 +107,7 @@   -- V2 4 6   (^+^) :: Num a => f a -> f a -> f a #ifndef HLINT-  default (^+^) :: (Num a) => f a -> f a -> f a+  default (^+^) :: Num a => f a -> f a -> f a   (^+^) = liftU2 (+)   {-# INLINE (^+^) #-} #endif@@ -67,7 +118,7 @@   -- V2 1 4   (^-^) :: Num a => f a -> f a -> f a #ifndef HLINT-  default (^-^) :: (Num a) => f a -> f a -> f a+  default (^-^) :: Num a => f a -> f a -> f a   x ^-^ y = x ^+^ negated y   {-# INLINE (^-^) #-} #endif@@ -77,35 +128,122 @@   lerp alpha u v = alpha *^ u ^+^ (1 - alpha) *^ v   {-# INLINE lerp #-} -  -- | Apply a function to merge the 'non-zero' components of two vectors.+  -- | Apply a function to merge the 'non-zero' components of two vectors, unioning the rest of the values.   --   -- * For a dense vector this is equivalent to 'liftA2'.   --   -- * For a sparse vector this is equivalent to 'unionWith'.   liftU2 :: (a -> a -> a) -> f a -> f a -> f a #ifndef HLINT-  default liftU2 :: (Applicative f) => (a -> a -> a) -> f a -> f a -> f a+  default liftU2 :: Applicative f => (a -> a -> a) -> f a -> f a -> f a   liftU2 = liftA2   {-# INLINE liftU2 #-} #endif +  -- | Apply a function to the components of two vectors.+  --+  -- * For a dense vector this is equivalent to 'liftA2'.+  --+  -- * For a sparse vector this is equivalent to 'intersectionWith'.+  liftI2 :: (a -> b -> c) -> f a -> f b -> f c+#ifndef HLINT+  default liftI2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c+  liftI2 = liftA2+  {-# INLINE liftI2 #-}+#endif++instance Additive ZipList where+  zero = ZipList []+  {-# INLINE zero #-}+  liftU2 f (ZipList xs) (ZipList ys) = ZipList (liftU2 f xs ys)+  {-# INLINE liftU2 #-}+  liftI2 = liftA2+  {-# INLINE liftI2 #-}++instance Additive Vector where+  zero = mempty+  {-# INLINE zero #-}+  liftU2 f u v = case compare lu lv of+    LT | lu == 0   -> v+       | otherwise -> modify (\ w -> Foldable.forM_ [0..lu-1] $ \i -> unsafeWrite w i $ f (unsafeIndex u i) (unsafeIndex v i)) v+    EQ -> Vector.zipWith f u v+    GT | lv == 0   -> u+       | otherwise -> modify (\ w -> Foldable.forM_ [0..lv-1] $ \i -> unsafeWrite w i $ f (unsafeIndex u i) (unsafeIndex v i)) u+    where+      lu = Vector.length u+      lv = Vector.length v+  {-# INLINE liftU2 #-}+  liftI2 = Vector.zipWith+  {-# INLINE liftI2 #-}++instance Additive Maybe where+  zero = Nothing+  {-# INLINE zero #-}+  liftU2 f (Just a) (Just b) = Just (f a b)+  liftU2 _ Nothing ys = ys+  liftU2 _ xs Nothing = xs+  {-# INLINE liftU2 #-}+  liftI2 = liftA2+  {-# INLINE liftI2 #-}++instance Additive [] where+  zero = []+  {-# INLINE zero #-}+  liftU2 f = go where+    go (x:xs) (y:ys) = f x y : go xs ys+    go [] ys = ys+    go xs [] = xs+  {-# INLINE liftU2 #-}+  liftI2 = Prelude.zipWith+  {-# INLINE liftI2 #-}+ instance Additive IntMap where   zero = IntMap.empty+  {-# INLINE zero #-}   liftU2 = IntMap.unionWith+  {-# INLINE liftU2 #-}+  liftI2 = IntMap.intersectionWith+  {-# INLINE liftI2 #-}  instance Ord k => Additive (Map k) where   zero = Map.empty+  {-# INLINE zero #-}   liftU2 = Map.unionWith+  {-# INLINE liftU2 #-}+  liftI2 = Map.intersectionWith+  {-# INLINE liftI2 #-}  instance (Eq k, Hashable k) => Additive (HashMap k) where   zero = HashMap.empty+  {-# INLINE zero #-}   liftU2 = HashMap.unionWith+  {-# INLINE liftU2 #-}+  liftI2 = HashMap.intersectionWith+  {-# INLINE liftI2 #-} -instance Additive ((->) b)+instance Additive ((->) b) where+  zero   = const 0+  {-# INLINE zero #-}+  liftU2 = liftA2+  {-# INLINE liftU2 #-}+  liftI2 = liftA2+  {-# INLINE liftI2 #-} -instance Additive Complex+instance Additive Complex where+  zero = 0 :+ 0+  {-# INLINE zero #-}+  liftU2 f (a :+ b) (c :+ d) = f a c :+ f b d+  {-# INLINE liftU2 #-}+  liftI2 f (a :+ b) (c :+ d) = f a c :+ f b d+  {-# INLINE liftI2 #-} -instance Additive Identity+instance Additive Identity where+  zero = Identity 0+  {-# INLINE zero #-}+  liftU2 = liftA2+  {-# INLINE liftU2 #-}+  liftI2 = liftA2+  {-# INLINE liftI2 #-}  -- | Compute the negation of a vector --@@ -156,3 +294,10 @@ basisFor v = [ setElement k 1 z | k <- [0..n-1] ]   where z = 0 <$ v         n = getSum $ foldMap (const (Sum 1)) v++-- | 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