{-# 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
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 ()
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
class Functor f => Additive f where
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
(^+^) :: 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 (^+^) #-}
(^-^) :: 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
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 #-}
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
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 #-}
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 #-}
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 #-}
(*^) :: (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 (*^) #-}
(^*) :: (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 (^*) #-}
(^/) :: (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 (^/) #-}
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)
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 #-}
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 #-}
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 :: (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