{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Nonlinear.Vector
( Vec (..),
negated,
(^*),
(*^),
(^/),
basis,
basisFor,
scaled,
outer,
unit,
dot,
quadrance,
qd,
distance,
norm,
signorm,
normalize,
project,
)
where
import Control.Applicative (liftA2)
import Data.Foldable (Foldable (foldl'), toList)
import Nonlinear.Internal (ASetter', Lens', imap, set)
class (Traversable v, Monad v) => Vec v where
construct :: ((forall b. Lens' (v b) b) -> a) -> v a
infixl 7 ^*, *^, ^/
negated :: (Vec 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 #-}
(*^) :: (Vec 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
a a -> a -> a
forall a. Num a => a -> a -> a
*)
{-# INLINE (*^) #-}
(^*) :: (Vec 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 (^*) #-}
(^/) :: (Vec 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 :: (Vec t, Num a) => [t a]
basis :: [t a]
basis = t () -> [t a]
forall (t :: * -> *) a b. (Vec t, Num a) => t b -> [t a]
basisFor (() -> t ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
basisFor :: (Vec t, Num a) => t b -> [t a]
basisFor :: t b -> [t a]
basisFor t b
t = t (t a) -> [t a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (t (t a) -> [t a]) -> t (t a) -> [t a]
forall a b. (a -> b) -> a -> b
$ (Int -> b -> t a) -> t b -> t (t a)
forall (t :: * -> *) a b.
Traversable t =>
(Int -> a -> b) -> t a -> t b
imap (\Int
i b
_ -> (Int -> b -> a) -> t b -> t a
forall (t :: * -> *) a b.
Traversable t =>
(Int -> a -> b) -> t a -> t b
imap (\Int
j b
_ -> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j then a
1 else a
0) t b
t) t b
t
{-# INLINEABLE basisFor #-}
scaled :: (Vec t, Num a) => t a -> t (t a)
scaled :: t a -> t (t a)
scaled t a
t = (Int -> a -> t a) -> t a -> t (t a)
forall (t :: * -> *) a b.
Traversable t =>
(Int -> a -> b) -> t a -> t b
imap (\Int
i a
_ -> (Int -> a -> a) -> t a -> t a
forall (t :: * -> *) a b.
Traversable t =>
(Int -> a -> b) -> t a -> t b
imap (\Int
j a
a -> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j then a
a else a
0) t a
t) t a
t
{-# INLINE scaled #-}
unit :: (Vec 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 (a -> t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
0)
{-# INLINE unit #-}
outer :: (Vec f, Vec 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
{-# INLINE outer #-}
dot :: (Vec f, Num a) => f a -> f a -> a
dot :: f a -> f a -> a
dot f a
a f a
b = (a -> a -> a) -> a -> f a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0 ((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 a -> a -> a
forall a. Num a => a -> a -> a
(+) f a
a f a
b)
{-# INLINE dot #-}
quadrance :: (Vec f, Num a) => f a -> a
quadrance :: f a -> a
quadrance = (a -> a -> a) -> a -> f a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\a
b a
a -> a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
a) a
0
{-# INLINE quadrance #-}
qd :: (Vec f, Num a) => f a -> f a -> a
qd :: f a -> f a -> a
qd f a
a f a
b = (a -> a -> a) -> a -> f a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0 (f a -> a) -> f a -> a
forall a b. (a -> b) -> a -> b
$ (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 (-) f a
a f a
b
{-# INLINE qd #-}
distance :: (Vec f, Floating a) => f a -> f a -> a
distance :: f a -> f a -> a
distance f a
f f a
g = f a -> a
forall (f :: * -> *) a. (Vec f, Floating a) => f a -> a
norm (f a -> a) -> f a -> a
forall a b. (a -> b) -> a -> b
$ (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 (-) f a
f f a
g
{-# INLINE distance #-}
norm :: (Vec f, Floating a) => f a -> a
norm :: f a -> a
norm f a
v = a -> a
forall a. Floating a => a -> a
sqrt (f a -> a
forall (f :: * -> *) a. (Vec f, Num a) => f a -> a
quadrance f a
v)
{-# INLINE norm #-}
signorm :: (Vec f, Floating a) => f a -> f a
signorm :: f a -> f a
signorm f a
v = (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
/ f a -> a
forall (f :: * -> *) a. (Vec f, Floating a) => f a -> a
norm f a
v) f a
v
{-# INLINE signorm #-}
normalize :: (Vec f, Floating a) => f a -> f a
normalize :: f a -> f a
normalize = f a -> f a
forall (f :: * -> *) a. (Vec f, Floating a) => f a -> f a
signorm
{-# INLINE normalize #-}
project :: (Vec v, Fractional a) => v a -> v a -> v a
project :: v a -> v a -> v a
project v a
u v a
v = ((v a
v v a -> v a -> a
forall (f :: * -> *) a. (Vec f, Num a) => f a -> f a -> a
`dot` v a
u) a -> a -> a
forall a. Fractional a => a -> a -> a
/ v a -> a
forall (f :: * -> *) a. (Vec f, Num a) => f a -> a
quadrance v a
u) a -> v a -> v a
forall (f :: * -> *) a. (Vec f, Num a) => a -> f a -> f a
*^ v a
u
{-# INLINE project #-}