{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE DefaultSignatures #-}
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2012-2015 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
-- Operations on free vector spaces.
-----------------------------------------------------------------------------
module Linear.Vector
  ( Additive(..)
  , E(..)
  , negated
  , (^*)
  , (*^)
  , (^/)
  , sumV
  , basis
  , basisFor
  , scaled
  , outer
  , unit
  ) where

import Control.Applicative
import Control.Lens
import Data.Complex
import Data.Foldable as Foldable (forM_, foldl')
import Data.Functor.Compose
import Data.Functor.Product
import Data.HashMap.Lazy as HashMap
import Data.Hashable
import Data.IntMap as IntMap
import Data.Map as Map
import qualified Data.Vector as Vector
import Data.Vector (Vector)
import qualified Data.Vector.Mutable as Mutable
import GHC.Generics
import Linear.Instances ()

-- $setup
-- >>> import Linear.V2

-- | Basis element
newtype E t = E { forall (t :: * -> *). E t -> forall x. Lens' (t x) x
el :: forall x. Lens' (t x) x }

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 :: forall a. Num a => U1 a
gzero = U1 a
forall k (p :: k). U1 p
U1
  {-# INLINE gzero #-}
  gliftU2 :: forall a. (a -> a -> a) -> U1 a -> U1 a -> U1 a
gliftU2 a -> a -> a
_ U1 a
U1 U1 a
U1 = U1 a
forall k (p :: k). U1 p
U1
  {-# INLINE gliftU2 #-}
  gliftI2 :: forall a b c. (a -> b -> c) -> U1 a -> U1 b -> U1 c
gliftI2 a -> b -> c
_ U1 a
U1 U1 b
U1 = U1 c
forall k (p :: k). U1 p
U1
  {-# INLINE gliftI2 #-}

instance (GAdditive f, GAdditive g) => GAdditive (f :*: g) where
  gzero :: forall a. Num a => (:*:) f g a
gzero = f a
forall a. Num a => f a
forall (f :: * -> *) a. (GAdditive f, Num a) => f a
gzero f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
forall a. Num a => g a
forall (f :: * -> *) a. (GAdditive f, Num a) => f a
gzero
  {-# INLINE gzero #-}
  gliftU2 :: forall a.
(a -> a -> a) -> (:*:) f g a -> (:*:) f g a -> (:*:) f g a
gliftU2 a -> a -> a
f (f a
a :*: g a
b) (f a
c :*: g a
d) = (a -> a -> a) -> f a -> f a -> f a
forall a. (a -> a -> a) -> f a -> f a -> f a
forall (f :: * -> *) a.
GAdditive f =>
(a -> a -> a) -> f a -> f a -> f a
gliftU2 a -> a -> a
f f a
a f a
c f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (a -> a -> a) -> g a -> g a -> g a
forall a. (a -> a -> a) -> g a -> g a -> g a
forall (f :: * -> *) a.
GAdditive f =>
(a -> a -> a) -> f a -> f a -> f a
gliftU2 a -> a -> a
f g a
b g a
d
  {-# INLINE gliftU2 #-}
  gliftI2 :: forall a b c.
(a -> b -> c) -> (:*:) f g a -> (:*:) f g b -> (:*:) f g c
gliftI2 a -> b -> c
f (f a
a :*: g a
b) (f b
c :*: g b
d) = (a -> b -> c) -> f a -> f b -> f c
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
GAdditive f =>
(a -> b -> c) -> f a -> f b -> f c
gliftI2 a -> b -> c
f f a
a f b
c f c -> g c -> (:*:) f g c
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (a -> b -> c) -> g a -> g b -> g c
forall a b c. (a -> b -> c) -> g a -> g b -> g c
forall (f :: * -> *) a b c.
GAdditive f =>
(a -> b -> c) -> f a -> f b -> f c
gliftI2 a -> b -> c
f g a
b g b
d
  {-# INLINE gliftI2 #-}

instance (Additive f, GAdditive g) => GAdditive (f :.: g) where
  gzero :: forall a. Num a => (:.:) f g a
gzero = f (g a) -> (:.:) f g a
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (g a) -> (:.:) f g a) -> f (g a) -> (:.:) f g a
forall a b. (a -> b) -> a -> b
$ g a
forall a. Num a => g a
forall (f :: * -> *) a. (GAdditive f, Num a) => f a
gzero g a -> f Int -> f (g a)
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (f Int
forall a. Num a => f a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero :: f Int)
  {-# INLINE gzero #-}
  gliftU2 :: forall a.
(a -> a -> a) -> (:.:) f g a -> (:.:) f g a -> (:.:) f g a
gliftU2 a -> a -> a
f (Comp1 f (g a)
a) (Comp1 f (g a)
b) = f (g a) -> (:.:) f g a
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (g a) -> (:.:) f g a) -> f (g a) -> (:.:) f g a
forall a b. (a -> b) -> a -> b
$ (g a -> g a -> g a) -> f (g a) -> f (g a) -> f (g a)
forall a. (a -> a -> a) -> f a -> f a -> f a
forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 ((a -> a -> a) -> g a -> g a -> g a
forall a. (a -> a -> a) -> g a -> g a -> g a
forall (f :: * -> *) a.
GAdditive f =>
(a -> a -> a) -> f a -> f a -> f a
gliftU2 a -> a -> a
f) f (g a)
a f (g a)
b
  {-# INLINE gliftU2 #-}
  gliftI2 :: forall a b c.
(a -> b -> c) -> (:.:) f g a -> (:.:) f g b -> (:.:) f g c
gliftI2 a -> b -> c
f (Comp1 f (g a)
a) (Comp1 f (g b)
b) = f (g c) -> (:.:) f g c
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (g c) -> (:.:) f g c) -> f (g c) -> (:.:) f g c
forall a b. (a -> b) -> a -> b
$ (g a -> g b -> g c) -> f (g a) -> f (g b) -> f (g c)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 ((a -> b -> c) -> g a -> g b -> g c
forall a b c. (a -> b -> c) -> g a -> g b -> g c
forall (f :: * -> *) a b c.
GAdditive f =>
(a -> b -> c) -> f a -> f b -> f c
gliftI2 a -> b -> c
f) f (g a)
a f (g b)
b
  {-# INLINE gliftI2 #-}

instance Additive f => GAdditive (Rec1 f) where
  gzero :: forall a. Num a => Rec1 f a
gzero = f a -> Rec1 f a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 f a
forall a. Num a => f a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
  {-# INLINE gzero #-}
  gliftU2 :: forall a. (a -> a -> a) -> Rec1 f a -> Rec1 f a -> Rec1 f a
gliftU2 a -> a -> a
f (Rec1 f a
g) (Rec1 f a
h) = f a -> Rec1 f a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 ((a -> a -> a) -> f a -> f a -> f a
forall a. (a -> a -> a) -> f a -> f a -> f a
forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 a -> a -> a
f f a
g f a
h)
  {-# INLINE gliftU2 #-}
  gliftI2 :: forall a b c. (a -> b -> c) -> Rec1 f a -> Rec1 f b -> Rec1 f c
gliftI2 a -> b -> c
f (Rec1 f a
g) (Rec1 f b
h) = f c -> Rec1 f c
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 ((a -> b -> c) -> f a -> f b -> f c
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 a -> b -> c
f f a
g f b
h)
  {-# INLINE gliftI2 #-}

instance GAdditive f => GAdditive (M1 i c f) where
  gzero :: forall a. Num a => M1 i c f a
gzero = f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 f a
forall a. Num a => f a
forall (f :: * -> *) a. (GAdditive f, Num a) => f a
gzero
  {-# INLINE gzero #-}
  gliftU2 :: forall a. (a -> a -> a) -> M1 i c f a -> M1 i c f a -> M1 i c f a
gliftU2 a -> a -> a
f (M1 f a
g) (M1 f a
h) = f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 ((a -> a -> a) -> f a -> f a -> f a
forall a. (a -> a -> a) -> f a -> f a -> f a
forall (f :: * -> *) a.
GAdditive f =>
(a -> a -> a) -> f a -> f a -> f a
gliftU2 a -> a -> a
f f a
g f a
h)
  {-# INLINE gliftU2 #-}
  gliftI2 :: forall a b c.
(a -> b -> c) -> M1 i c f a -> M1 i c f b -> M1 i c f c
gliftI2 a -> b -> c
f (M1 f a
g) (M1 f b
h) = f c -> M1 i c f c
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 ((a -> b -> c) -> f a -> f b -> f c
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
GAdditive f =>
(a -> b -> c) -> f a -> f b -> f c
gliftI2 a -> b -> c
f f a
g f b
h)
  {-# INLINE gliftI2 #-}

instance GAdditive Par1 where
  gzero :: forall a. Num a => Par1 a
gzero = a -> Par1 a
forall p. p -> Par1 p
Par1 a
0
  gliftU2 :: forall a. (a -> a -> a) -> Par1 a -> Par1 a -> Par1 a
gliftU2 a -> a -> a
f (Par1 a
a) (Par1 a
b) = a -> Par1 a
forall p. p -> Par1 p
Par1 (a -> a -> a
f a
a a
b)
  {-# INLINE gliftU2 #-}
  gliftI2 :: forall a b c. (a -> b -> c) -> Par1 a -> Par1 b -> Par1 c
gliftI2 a -> b -> c
f (Par1 a
a) (Par1 b
b) = c -> Par1 c
forall p. p -> Par1 p
Par1 (a -> b -> c
f a
a b
b)
  {-# INLINE gliftI2 #-}

-- | A vector is an additive group with additional structure.
class Functor f => Additive f where
  -- | The zero vector
  zero :: Num a => f a
#ifndef HLINT
  default zero :: (GAdditive (Rep1 f), Generic1 f, Num a) => f a
  zero = Rep1 f a -> f a
forall a. Rep1 f a -> f a
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 Rep1 f a
forall a. Num a => Rep1 f a
forall (f :: * -> *) a. (GAdditive f, Num a) => f a
gzero
#endif

  -- | Compute the sum of two vectors
  --
  -- >>> V2 1 2 ^+^ V2 3 4
  -- V2 4 6
  (^+^) :: Num a => f a -> f a -> f a
  (^+^) = (a -> a -> a) -> f a -> f a -> f a
forall a. (a -> a -> a) -> f a -> f a -> f a
forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 a -> a -> a
forall a. Num a => a -> a -> a
(+)
  {-# INLINE (^+^) #-}

  -- | Compute the difference between two vectors
  --
  -- >>> V2 4 5 ^-^ V2 3 1
  -- V2 1 4
  (^-^) :: Num a => f a -> f a -> f a
  f a
x ^-^ f a
y = f a
x f a -> f a -> f a
forall a. Num a => f a -> f a -> f a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ f a -> f a
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated f a
y

  -- | Linearly interpolate between two vectors.
  --
  -- /Since linear version 1.23, interpolation direction has been reversed; now/
  --
  -- > lerp 0 a b == a
  -- > lerp 1 a b == b
  lerp :: Num a => a -> f a -> f a -> f a
  lerp a
alpha f a
u f a
v = (a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
alpha) a -> f a -> f a
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ f a
u f a -> f a -> f a
forall a. Num a => f a -> f a -> f a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ a
alpha a -> f a -> f a
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ f a
v
  {-# INLINE lerp #-}

  -- | 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
  liftU2 = (a -> a -> a) -> f a -> f a -> f a
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
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 = (a -> b -> c) -> f a -> f b -> f c
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
  {-# INLINE liftI2 #-}
#endif

instance (Additive f, Additive g) => Additive (Product f g) where
  zero :: forall a. Num a => Product f g a
zero = f a -> g a -> Product f g a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f a
forall a. Num a => f a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero g a
forall a. Num a => g a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
  liftU2 :: forall a.
(a -> a -> a) -> Product f g a -> Product f g a -> Product f g a
liftU2 a -> a -> a
f (Pair f a
a g a
b) (Pair f a
c g a
d) = f a -> g a -> Product f g a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair ((a -> a -> a) -> f a -> f a -> f a
forall a. (a -> a -> a) -> f a -> f a -> f a
forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 a -> a -> a
f f a
a f a
c) ((a -> a -> a) -> g a -> g a -> g a
forall a. (a -> a -> a) -> g a -> g a -> g a
forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 a -> a -> a
f g a
b g a
d)
  liftI2 :: forall a b c.
(a -> b -> c) -> Product f g a -> Product f g b -> Product f g c
liftI2 a -> b -> c
f (Pair f a
a g a
b) (Pair f b
c g b
d) = f c -> g c -> Product f g c
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair ((a -> b -> c) -> f a -> f b -> f c
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 a -> b -> c
f f a
a f b
c) ((a -> b -> c) -> g a -> g b -> g c
forall a b c. (a -> b -> c) -> g a -> g b -> g c
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 a -> b -> c
f g a
b g b
d)
  Pair f a
a g a
b ^+^ :: forall a. Num a => Product f g a -> Product f g a -> Product f g a
^+^ Pair f a
c g a
d = f a -> g a -> Product f g a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (f a
a f a -> f a -> f a
forall a. Num a => f a -> f a -> f a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ f a
c) (g a
b g a -> g a -> g a
forall a. Num a => g a -> g a -> g a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ g a
d)
  Pair f a
a g a
b ^-^ :: forall a. Num a => Product f g a -> Product f g a -> Product f g a
^-^ Pair f a
c g a
d = f a -> g a -> Product f g a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (f a
a f a -> f a -> f a
forall a. Num a => f a -> f a -> f a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ f a
c) (g a
b g a -> g a -> g a
forall a. Num a => g a -> g a -> g a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ g a
d)
  lerp :: forall a.
Num a =>
a -> Product f g a -> Product f g a -> Product f g a
lerp a
alpha (Pair f a
a g a
b) (Pair f a
c g a
d) = f a -> g a -> Product f g a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (a -> f a -> f a -> f a
forall a. Num a => a -> f a -> f a -> f a
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp a
alpha f a
a f a
c) (a -> g a -> g a -> g a
forall a. Num a => a -> g a -> g a -> g a
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp a
alpha g a
b g a
d)

instance (Additive f, Additive g) => Additive (Compose f g) where
  zero :: forall a. Num a => Compose f g a
zero = f (g a) -> Compose f g a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g a) -> Compose f g a) -> f (g a) -> Compose f g a
forall a b. (a -> b) -> a -> b
$ g a
forall a. Num a => g a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero g a -> f Int -> f (g a)
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (f Int
forall a. Num a => f a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero :: f Int)
  {-# INLINE zero #-}
  Compose f (g a)
a ^+^ :: forall a. Num a => Compose f g a -> Compose f g a -> Compose f g a
^+^ Compose f (g a)
b = f (g a) -> Compose f g a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g a) -> Compose f g a) -> f (g a) -> Compose f g a
forall a b. (a -> b) -> a -> b
$ (g a -> g a -> g a) -> f (g a) -> f (g a) -> f (g a)
forall a. (a -> a -> a) -> f a -> f a -> f a
forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 g a -> g a -> g a
forall a. Num a => g a -> g a -> g a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
(^+^) f (g a)
a f (g a)
b
  {-# INLINE (^+^) #-}
  Compose f (g a)
a ^-^ :: forall a. Num a => Compose f g a -> Compose f g a -> Compose f g a
^-^ Compose f (g a)
b = f (g a) -> Compose f g a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g a) -> Compose f g a) -> f (g a) -> Compose f g a
forall a b. (a -> b) -> a -> b
$ (g a -> g a -> g a) -> f (g a) -> f (g a) -> f (g a)
forall a. (a -> a -> a) -> f a -> f a -> f a
forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 g a -> g a -> g a
forall a. Num a => g a -> g a -> g a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
(^-^) f (g a)
a f (g a)
b
  {-# INLINE (^-^) #-}
  liftU2 :: forall a.
(a -> a -> a) -> Compose f g a -> Compose f g a -> Compose f g a
liftU2 a -> a -> a
f (Compose f (g a)
a) (Compose f (g a)
b) = f (g a) -> Compose f g a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g a) -> Compose f g a) -> f (g a) -> Compose f g a
forall a b. (a -> b) -> a -> b
$ (g a -> g a -> g a) -> f (g a) -> f (g a) -> f (g a)
forall a. (a -> a -> a) -> f a -> f a -> f a
forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 ((a -> a -> a) -> g a -> g a -> g a
forall a. (a -> a -> a) -> g a -> g a -> g a
forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 a -> a -> a
f) f (g a)
a f (g a)
b
  {-# INLINE liftU2 #-}
  liftI2 :: forall a b c.
(a -> b -> c) -> Compose f g a -> Compose f g b -> Compose f g c
liftI2 a -> b -> c
f (Compose f (g a)
a) (Compose f (g b)
b) = f (g c) -> Compose f g c
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g c) -> Compose f g c) -> f (g c) -> Compose f g c
forall a b. (a -> b) -> a -> b
$ (g a -> g b -> g c) -> f (g a) -> f (g b) -> f (g c)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 ((a -> b -> c) -> g a -> g b -> g c
forall a b c. (a -> b -> c) -> g a -> g b -> g c
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 a -> b -> c
f) f (g a)
a f (g b)
b
  {-# INLINE liftI2 #-}

instance Additive ZipList where
  zero :: forall a. Num a => ZipList a
zero = [a] -> ZipList a
forall a. [a] -> ZipList a
ZipList []
  {-# INLINE zero #-}
  liftU2 :: forall a. (a -> a -> a) -> ZipList a -> ZipList a -> ZipList a
liftU2 a -> a -> a
f (ZipList [a]
xs) (ZipList [a]
ys) = [a] -> ZipList a
forall a. [a] -> ZipList a
ZipList ((a -> a -> a) -> [a] -> [a] -> [a]
forall a. (a -> a -> a) -> [a] -> [a] -> [a]
forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 a -> a -> a
f [a]
xs [a]
ys)
  {-# INLINE liftU2 #-}
  liftI2 :: forall a b c. (a -> b -> c) -> ZipList a -> ZipList b -> ZipList c
liftI2 = (a -> b -> c) -> ZipList a -> ZipList b -> ZipList c
forall a b c. (a -> b -> c) -> ZipList a -> ZipList b -> ZipList c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
  {-# INLINE liftI2 #-}

instance Additive Vector where
  zero :: forall a. Num a => Vector a
zero = Vector a
forall a. Monoid a => a
mempty
  {-# INLINE zero #-}
  liftU2 :: forall a. (a -> a -> a) -> Vector a -> Vector a -> Vector a
liftU2 a -> a -> a
f Vector a
u Vector a
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
lu Int
lv of
    Ordering
LT | Int
lu Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   -> Vector a
v
       | Bool
otherwise -> (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
forall a.
(forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
Vector.modify (\ MVector s a
w -> [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
Foldable.forM_ [Int
0..Int
luInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
Mutable.unsafeWrite MVector s a
MVector (PrimState (ST s)) a
w Int
i (a -> ST s ()) -> a -> ST s ()
forall a b. (a -> b) -> a -> b
$ a -> a -> a
f (Vector a -> Int -> a
forall a. Vector a -> Int -> a
Vector.unsafeIndex Vector a
u Int
i) (Vector a -> Int -> a
forall a. Vector a -> Int -> a
Vector.unsafeIndex Vector a
v Int
i)) Vector a
v
    Ordering
EQ -> (a -> a -> a) -> Vector a -> Vector a -> Vector a
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
Vector.zipWith a -> a -> a
f Vector a
u Vector a
v
    Ordering
GT | Int
lv Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   -> Vector a
u
       | Bool
otherwise -> (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
forall a.
(forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
Vector.modify (\ MVector s a
w -> [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
Foldable.forM_ [Int
0..Int
lvInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
Mutable.unsafeWrite MVector s a
MVector (PrimState (ST s)) a
w Int
i (a -> ST s ()) -> a -> ST s ()
forall a b. (a -> b) -> a -> b
$ a -> a -> a
f (Vector a -> Int -> a
forall a. Vector a -> Int -> a
Vector.unsafeIndex Vector a
u Int
i) (Vector a -> Int -> a
forall a. Vector a -> Int -> a
Vector.unsafeIndex Vector a
v Int
i)) Vector a
u
    where
      lu :: Int
lu = Vector a -> Int
forall a. Vector a -> Int
Vector.length Vector a
u
      lv :: Int
lv = Vector a -> Int
forall a. Vector a -> Int
Vector.length Vector a
v
  {-# INLINE liftU2 #-}
  liftI2 :: forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
liftI2 = (a -> b -> c) -> Vector a -> Vector b -> Vector c
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
Vector.zipWith
  {-# INLINE liftI2 #-}

instance Additive Maybe where
  zero :: forall a. Num a => Maybe a
zero = Maybe a
forall a. Maybe a
Nothing
  {-# INLINE zero #-}
  liftU2 :: forall a. (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
liftU2 a -> a -> a
f (Just a
a) (Just a
b) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> a -> a
f a
a a
b)
  liftU2 a -> a -> a
_ Maybe a
Nothing Maybe a
ys = Maybe a
ys
  liftU2 a -> a -> a
_ Maybe a
xs Maybe a
Nothing = Maybe a
xs
  {-# INLINE liftU2 #-}
  liftI2 :: forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
liftI2 = (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
  {-# INLINE liftI2 #-}

instance Additive [] where
  zero :: forall a. Num a => [a]
zero = []
  {-# INLINE zero #-}
  liftU2 :: forall a. (a -> a -> a) -> [a] -> [a] -> [a]
liftU2 a -> a -> a
f = [a] -> [a] -> [a]
go where
    go :: [a] -> [a] -> [a]
go (a
x:[a]
xs) (a
y:[a]
ys) = a -> a -> a
f a
x a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go [a]
xs [a]
ys
    go [] [a]
ys = [a]
ys
    go [a]
xs [] = [a]
xs
  {-# INLINE liftU2 #-}
  liftI2 :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
liftI2 = (a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
Prelude.zipWith
  {-# INLINE liftI2 #-}

instance Additive IntMap where
  zero :: forall a. Num a => IntMap a
zero = IntMap a
forall a. IntMap a
IntMap.empty
  {-# INLINE zero #-}
  liftU2 :: forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
liftU2 = (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith
  {-# INLINE liftU2 #-}
  liftI2 :: forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
liftI2 = (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IntMap.intersectionWith
  {-# INLINE liftI2 #-}

instance Ord k => Additive (Map k) where
  zero :: forall a. Num a => Map k a
zero = Map k a
forall k a. Map k a
Map.empty
  {-# INLINE zero #-}
  liftU2 :: forall a. (a -> a -> a) -> Map k a -> Map k a -> Map k a
liftU2 = (a -> a -> a) -> Map k a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith
  {-# INLINE liftU2 #-}
  liftI2 :: forall a b c. (a -> b -> c) -> Map k a -> Map k b -> Map k c
liftI2 = (a -> b -> c) -> Map k a -> Map k b -> Map k c
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith
  {-# INLINE liftI2 #-}

instance (Eq k, Hashable k) => Additive (HashMap k) where
  zero :: forall a. Num a => HashMap k a
zero = HashMap k a
forall k v. HashMap k v
HashMap.empty
  {-# INLINE zero #-}
  liftU2 :: forall a.
(a -> a -> a) -> HashMap k a -> HashMap k a -> HashMap k a
liftU2 = (a -> a -> a) -> HashMap k a -> HashMap k a -> HashMap k a
forall k v.
Eq k =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith
  {-# INLINE liftU2 #-}
  liftI2 :: forall a b c.
(a -> b -> c) -> HashMap k a -> HashMap k b -> HashMap k c
liftI2 = (a -> b -> c) -> HashMap k a -> HashMap k b -> HashMap k c
forall k v1 v2 v3.
Eq k =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HashMap.intersectionWith
  {-# INLINE liftI2 #-}

instance Additive ((->) b) where
  zero :: forall a. Num a => b -> a
zero   = a -> b -> a
forall a b. a -> b -> a
const a
0
  {-# INLINE zero #-}
  liftU2 :: forall a. (a -> a -> a) -> (b -> a) -> (b -> a) -> b -> a
liftU2 = (a -> a -> a) -> (b -> a) -> (b -> a) -> b -> a
forall a b c. (a -> b -> c) -> (b -> a) -> (b -> b) -> b -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
  {-# INLINE liftU2 #-}
  liftI2 :: forall a b c. (a -> b -> c) -> (b -> a) -> (b -> b) -> b -> c
liftI2 = (a -> b -> c) -> (b -> a) -> (b -> b) -> b -> c
forall a b c. (a -> b -> c) -> (b -> a) -> (b -> b) -> b -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
  {-# INLINE liftI2 #-}

instance Additive Complex where
  zero :: forall a. Num a => Complex a
zero = a
0 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
0
  {-# INLINE zero #-}
  liftU2 :: forall a. (a -> a -> a) -> Complex a -> Complex a -> Complex a
liftU2 a -> a -> a
f (a
a :+ a
b) (a
c :+ a
d) = a -> a -> a
f a
a a
c a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a -> a -> a
f a
b a
d
  {-# INLINE liftU2 #-}
  liftI2 :: forall a b c. (a -> b -> c) -> Complex a -> Complex b -> Complex c
liftI2 a -> b -> c
f (a
a :+ a
b) (b
c :+ b
d) = a -> b -> c
f a
a b
c c -> c -> Complex c
forall a. a -> a -> Complex a
:+ a -> b -> c
f a
b b
d
  {-# INLINE liftI2 #-}

instance Additive Identity where
  zero :: forall a. Num a => Identity a
zero = a -> Identity a
forall a. a -> Identity a
Identity a
0
  {-# INLINE zero #-}
  liftU2 :: forall a. (a -> a -> a) -> Identity a -> Identity a -> Identity a
liftU2 = (a -> a -> a) -> Identity a -> Identity a -> Identity a
forall a b c.
(a -> b -> c) -> Identity a -> Identity b -> Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
  {-# INLINE liftU2 #-}
  liftI2 :: forall a b c.
(a -> b -> c) -> Identity a -> Identity b -> Identity c
liftI2 = (a -> b -> c) -> Identity a -> Identity b -> Identity c
forall a b c.
(a -> b -> c) -> Identity a -> Identity b -> Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
  {-# INLINE liftI2 #-}

-- | Compute the negation of a vector
--
-- >>> negated (V2 2 4)
-- V2 (-2) (-4)
negated :: (Functor f, Num a) => f a -> f a
negated :: forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated = (a -> a) -> f a -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate
{-# INLINE negated #-}

-- | Sum over multiple vectors
--
-- >>> sumV [V2 1 1, V2 3 4]
-- V2 4 5
sumV :: (Foldable f, Additive v, Num a) => f (v a) -> v a
sumV :: forall (f :: * -> *) (v :: * -> *) a.
(Foldable f, Additive v, Num a) =>
f (v a) -> v a
sumV = (v a -> v a -> v a) -> v a -> f (v a) -> v a
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' v a -> v a -> v a
forall a. Num a => v a -> v a -> v a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
(^+^) v a
forall a. Num a => v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
{-# INLINE sumV #-}

-- | Compute the left scalar product
--
-- >>> 2 *^ V2 3 4
-- V2 6 8
(*^) :: (Functor f, Num a) => a -> f a -> f a
*^ :: forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
(*^) a
a = (a -> a) -> f a -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
aa -> a -> a
forall a. Num a => a -> a -> a
*)
{-# INLINE (*^) #-}

-- | Compute the right scalar product
--
-- >>> V2 3 4 ^* 2
-- V2 6 8
(^*) :: (Functor f, Num a) => f a -> a -> f a
f a
f ^* :: forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* a
a = (a -> a) -> f a -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> a
forall a. Num a => a -> a -> a
*a
a) f a
f
{-# INLINE (^*) #-}

-- | Compute division by a scalar on the right.
(^/) :: (Functor f, Fractional a) => f a -> a -> f a
f a
f ^/ :: forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ a
a = (a -> a) -> f a -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> a
forall a. Fractional a => a -> a -> a
/a
a) f a
f
{-# INLINE (^/) #-}

-- | Produce a default basis for a vector space. If the dimensionality
-- of the vector space is not statically known, see 'basisFor'.
basis :: (Additive t, Traversable t, Num a) => [t a]
basis :: forall (t :: * -> *) a. (Additive t, Traversable t, Num a) => [t a]
basis = t Int -> [t a]
forall (t :: * -> *) a b. (Traversable t, Num a) => t b -> [t a]
basisFor (v Int
forall a. Num a => v a
forall {v :: * -> *}. Additive v => v Int
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero :: Additive v => v Int)

-- | Produce a default basis for a vector space from which the
-- argument is drawn.
basisFor :: (Traversable t, Num a) => t b -> [t a]
basisFor :: forall (t :: * -> *) a b. (Traversable t, Num a) => t b -> [t a]
basisFor = \t b
t ->
   IndexedGetting Int [t a] (t b) b
-> (Int -> b -> [t a]) -> t b -> [t a]
forall i m s a. IndexedGetting i m s a -> (i -> a -> m) -> s -> m
ifoldMapOf IndexedGetting Int [t a] (t b) b
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal Int (t b) (t b) b b
traversed ((Int -> b -> [t a]) -> t b -> [t a])
-> t b -> (Int -> b -> [t a]) -> [t a]
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? t b
t ((Int -> b -> [t a]) -> [t a]) -> (Int -> b -> [t a]) -> [t a]
forall a b. (a -> b) -> a -> b
$ \Int
i b
_ ->
     t a -> [t a]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return                  (t a -> [t a]) -> t a -> [t a]
forall a b. (a -> b) -> a -> b
$
       AnIndexedSetter Int (t b) (t a) b a
-> (Int -> b -> a) -> t b -> t a
forall i s t a b.
AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t
iover  AnIndexedSetter Int (t b) (t a) b a
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal Int (t b) (t a) b a
traversed ((Int -> b -> a) -> t b -> t a) -> t b -> (Int -> b -> a) -> t a
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? t b
t ((Int -> b -> a) -> t a) -> (Int -> b -> a) -> t a
forall a b. (a -> b) -> a -> b
$ \Int
j b
_ ->
         if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j then a
1 else a
0
{-# INLINABLE basisFor #-}

-- | Produce a diagonal (scale) matrix from a vector.
--
-- >>> scaled (V2 2 3)
-- V2 (V2 2 0) (V2 0 3)
scaled :: (Traversable t, Num a) => t a -> t (t a)
scaled :: forall (t :: * -> *) a. (Traversable t, Num a) => t a -> t (t a)
scaled = \t a
t -> t a -> (Int -> a -> t a) -> t (t a)
forall (t :: * -> *) a b.
Traversable t =>
t a -> (Int -> a -> b) -> t b
iter t a
t (\Int
i a
x -> t a -> (Int -> a -> a) -> t a
forall (t :: * -> *) a b.
Traversable t =>
t a -> (Int -> a -> b) -> t b
iter t a
t (\Int
j a
_ -> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j then a
x else a
0))
  where
  iter :: Traversable t => t a -> (Int -> a -> b) -> t b
  iter :: forall (t :: * -> *) a b.
Traversable t =>
t a -> (Int -> a -> b) -> t b
iter t a
x Int -> a -> b
f = AnIndexedSetter Int (t a) (t b) a b
-> (Int -> a -> b) -> t a -> t b
forall i s t a b.
AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t
iover AnIndexedSetter Int (t a) (t b) a b
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal Int (t a) (t b) a b
traversed Int -> a -> b
f t a
x
{-# INLINE scaled #-}

-- | Create a unit vector.
--
-- >>> unit _x :: V2 Int
-- V2 1 0
unit :: (Additive t, Num a) => ASetter' (t a) a -> t a
unit :: forall (t :: * -> *) a.
(Additive t, Num a) =>
ASetter' (t a) a -> t a
unit ASetter' (t a) a
l = ASetter' (t a) a -> a -> t a -> t a
forall s a. ASetter' s a -> a -> s -> s
set' ASetter' (t a) a
l a
1 t a
forall a. Num a => t a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero

-- | Outer (tensor) product of two vectors
outer :: (Functor f, Functor g, Num a) => f a -> g a -> f (g a)
outer :: forall (f :: * -> *) (g :: * -> *) a.
(Functor f, Functor g, Num a) =>
f a -> g a -> f (g a)
outer f a
a g a
b = (a -> g a) -> f a -> f (g a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x->(a -> a) -> g a -> g a
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> a
forall a. Num a => a -> a -> a
*a
x) g a
b) f a
a