{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE DefaultSignatures #-}
#define USE_GHC_GENERICS
#endif
-----------------------------------------------------------------------------
-- |
-- 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
#if __GLASGOW_HASKELL__ < 710
import Data.Foldable as Foldable (Foldable, forM_, foldl')
#else
import Data.Foldable as Foldable (forM_, foldl')
#endif
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
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (mempty)
#endif
import qualified Data.Vector as Vector
import Data.Vector (Vector)
import qualified Data.Vector.Mutable as Mutable
#ifdef USE_GHC_GENERICS
import GHC.Generics
#endif
import Linear.Instances ()

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

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

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
  gliftI2 :: (a -> b -> c) -> f a -> f b -> f c

instance GAdditive U1 where
  gzero :: U1 a
gzero = U1 a
forall k (p :: k). U1 p
U1
  {-# INLINE gzero #-}
  gliftU2 :: (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 :: (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 :: (:*:) f g a
gzero = 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 (f :: * -> *) a. (GAdditive f, Num a) => f a
gzero
  {-# INLINE gzero #-}
  gliftU2 :: (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 (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 (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 :: (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 (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 (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 :: (:.:) 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 (f :: * -> *) a. (GAdditive f, Num a) => f a
gzero g a -> f Int -> f (g a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (f Int
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero :: f Int)
  {-# INLINE gzero #-}
  gliftU2 :: (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 (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 ((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 :: (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 (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 (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 :: Rec1 f a
gzero = f a -> Rec1 f a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 f a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
  {-# INLINE gzero #-}
  gliftU2 :: (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 (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 :: (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 (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 :: 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 (f :: * -> *) a. (GAdditive f, Num a) => f a
gzero
  {-# INLINE gzero #-}
  gliftU2 :: (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 (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 :: (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 (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 :: Par1 a
gzero = a -> Par1 a
forall p. p -> Par1 p
Par1 a
0
  gliftU2 :: (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 :: (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 #-}
#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 = Rep1 f a -> f a
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 Rep1 f a
forall (f :: * -> *) a. (GAdditive f, Num a) => f a
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
  (^+^) = (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 (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.
  lerp :: Num a => a -> f a -> f a -> f a
  lerp a
alpha f a
u f a
v = 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 (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (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
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
#ifdef USE_GHC_GENERICS
#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 (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
  {-# INLINE liftU2 #-}
#endif
#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
#ifdef USE_GHC_GENERICS
#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 (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
  {-# INLINE liftI2 #-}
#endif
#endif

instance (Additive f, Additive g) => Additive (Product f g) where
  zero :: 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 (f :: * -> *) a. (Additive f, Num a) => f a
zero g a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
  liftU2 :: (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 (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 (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 :: (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 (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 (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 ^+^ :: 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 (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 (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ g a
d)
  Pair f a
a g a
b ^-^ :: 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 (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 (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ g a
d)
  lerp :: 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 (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 (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 :: 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 (f :: * -> *) a. (Additive f, Num a) => f a
zero g a -> f Int -> f (g a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (f Int
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero :: f Int)
  {-# INLINE zero #-}
  Compose f (g a)
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 (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 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 ^-^ :: 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 (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 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 :: (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 (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 ((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 :: (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 (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 (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 :: ZipList a
zero = [a] -> ZipList a
forall a. [a] -> ZipList a
ZipList []
  {-# INLINE zero #-}
  liftU2 :: (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 (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 :: (a -> b -> c) -> ZipList a -> ZipList b -> ZipList c
liftI2 = (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 :: Vector a
zero = Vector a
forall a. Monoid a => a
mempty
  {-# INLINE zero #-}
  liftU2 :: (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 :: (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 :: Maybe a
zero = Maybe a
forall a. Maybe a
Nothing
  {-# INLINE zero #-}
  liftU2 :: (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 :: (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
liftI2 = (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 :: [a]
zero = []
  {-# INLINE zero #-}
  liftU2 :: (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 :: (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 :: IntMap a
zero = IntMap a
forall a. IntMap a
IntMap.empty
  {-# INLINE zero #-}
  liftU2 :: (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 :: (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 :: Map k a
zero = Map k a
forall k a. Map k a
Map.empty
  {-# INLINE zero #-}
  liftU2 :: (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 :: (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 :: HashMap k a
zero = HashMap k a
forall k v. HashMap k v
HashMap.empty
  {-# INLINE zero #-}
  liftU2 :: (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, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith
  {-# INLINE liftU2 #-}
  liftI2 :: (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, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HashMap.intersectionWith
  {-# INLINE liftI2 #-}

instance Additive ((->) b) where
  zero :: b -> a
zero   = a -> b -> a
forall a b. a -> b -> a
const a
0
  {-# INLINE zero #-}
  liftU2 :: (a -> a -> a) -> (b -> a) -> (b -> a) -> b -> a
liftU2 = (a -> a -> a) -> (b -> a) -> (b -> a) -> b -> a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
  {-# INLINE liftU2 #-}
  liftI2 :: (a -> b -> c) -> (b -> a) -> (b -> b) -> b -> c
liftI2 = (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 :: Complex a
zero = a
0 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
0
  {-# INLINE zero #-}
  liftU2 :: (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 :: (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 :: Identity a
zero = a -> Identity a
forall a. a -> Identity a
Identity a
0
  {-# INLINE zero #-}
  liftU2 :: (a -> a -> a) -> Identity a -> Identity a -> Identity a
liftU2 = (a -> a -> a) -> Identity a -> Identity a -> Identity a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
  {-# INLINE liftU2 #-}
  liftI2 :: (a -> b -> c) -> Identity a -> Identity b -> Identity c
liftI2 = (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 :: f a -> f a
negated = (a -> a) -> f a -> f a
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 :: f (v a) -> v a
sumV = (v a -> v a -> v a) -> v a -> f (v a) -> v a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' v a -> v a -> v a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f 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
*^ :: a -> f a -> f a
(*^) a
a = (a -> a) -> f a -> f a
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 ^* :: f a -> a -> f a
^* a
a = (a -> a) -> f a -> f a
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 ^/ :: f a -> a -> f a
^/ a
a = (a -> a) -> f a -> f a
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 :: [t a]
basis = t Int -> [t a]
forall (t :: * -> *) a b. (Traversable t, Num a) => t b -> [t a]
basisFor (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 :: 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
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 (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
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 :: 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 :: 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
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 :: 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 (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 :: f a -> g a -> f (g a)
outer f a
a g a
b = (a -> g a) -> f a -> f (g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x->(a -> a) -> g a -> g a
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