{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# 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.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 Data.Vector as Vector
import Data.Vector.Mutable as Mutable
#ifdef USE_GHC_GENERICS
import GHC.Generics
#endif
import Linear.Instances ()

{-# ANN module "HLint: ignore Redundant lambda" #-}

-- $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 _ U1 U1 = U1 a
forall k (p :: k). U1 p
U1
  {-# INLINE gliftU2 #-}
  gliftI2 :: (a -> b -> c) -> U1 a -> U1 b -> U1 c
gliftI2 _ U1 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 f :: a -> a -> a
f (a :: f a
a :*: b :: g a
b) (c :: f a
c :*: d :: 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 f :: a -> b -> c
f (a :: f a
a :*: b :: g a
b) (c :: f b
c :*: d :: 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 (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 f :: a -> a -> a
f (Rec1 g :: f a
g) (Rec1 h :: 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 f :: a -> b -> c
f (Rec1 g :: f a
g) (Rec1 h :: 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 f :: a -> a -> a
f (M1 g :: f a
g) (M1 h :: 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 f :: a -> b -> c
f (M1 g :: f a
g) (M1 h :: 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 0
  gliftU2 :: (a -> a -> a) -> Par1 a -> Par1 a -> Par1 a
gliftU2 f :: a -> a -> a
f (Par1 a :: a
a) (Par1 b :: 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 f :: a -> b -> c
f (Par1 a :: a
a) (Par1 b :: 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
  x :: f a
x ^-^ y :: 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 alpha :: a
alpha u :: f a
u v :: 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
^+^ (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 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 f :: a -> a -> a
f (ZipList xs :: [a]
xs) (ZipList ys :: [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 f :: a -> a -> a
f u :: Vector a
u v :: Vector a
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
lu Int
lv of
    LT | Int
lu Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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 (\ w :: 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_ [0..Int
luInt -> Int -> Int
forall a. Num a => a -> a -> a
-1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \i :: Int
i -> MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
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
unsafeIndex Vector a
u Int
i) (Vector a -> Int -> a
forall a. Vector a -> Int -> a
unsafeIndex Vector a
v Int
i)) Vector a
v
    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
    GT | Int
lv Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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 (\ w :: 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_ [0..Int
lvInt -> Int -> Int
forall a. Num a => a -> a -> a
-1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \i :: Int
i -> MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
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
unsafeIndex Vector a
u Int
i) (Vector a -> Int -> a
forall a. Vector a -> Int -> a
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 f :: a -> a -> a
f (Just a :: a
a) (Just b :: a
b) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> a -> a
f a
a a
b)
  liftU2 _ Nothing ys :: Maybe a
ys = Maybe a
ys
  liftU2 _ xs :: Maybe a
xs 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 f :: a -> a -> a
f = [a] -> [a] -> [a]
go where
    go :: [a] -> [a] -> [a]
go (x :: a
x:xs :: [a]
xs) (y :: a
y:ys :: [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 [] ys :: [a]
ys = [a]
ys
    go xs :: [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 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 = 0 a -> a -> Complex a
forall a. a -> a -> Complex a
:+ 0
  {-# INLINE zero #-}
  liftU2 :: (a -> a -> a) -> Complex a -> Complex a -> Complex a
liftU2 f :: a -> a -> a
f (a :: a
a :+ b :: a
b) (c :: a
c :+ d :: 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 f :: a -> b -> c
f (a :: a
a :+ b :: a
b) (c :: b
c :+ d :: 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 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 -> 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 :: f a
f ^* :: f a -> a -> f a
^* 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 :: f a
f ^/ :: f a -> a -> f a
^/ 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 :: 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
$ \i :: Int
i _ ->
     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
$ \j :: Int
j _ ->
         if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j then 1 else 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 :: 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 (\i :: Int
i x :: 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 (\j :: Int
j _ -> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j then a
x else 0))
  where
  iter :: Traversable t => t a -> (Int -> a -> b) -> t b
  iter :: t a -> (Int -> a -> b) -> t b
iter x :: t a
x f :: 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 l :: 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 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 a :: f a
a b :: g a
b = (a -> g a) -> f a -> f (g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: 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