-- | This module is a reduction of the `Linear` package

-- from Edward Kmett to match just the need of Rasterific.

--

-- If the flag `embed_linear` is disabled, this module is

-- just a reexport from the real linear package.

--

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP #-}
module Graphics.Rasterific.Linear
    ( V1( .. )
    , V2( .. )
    , V3( .. )
    , V4( .. )
    , R1( .. )
    , R2( .. )
    , Additive( .. )
    , Epsilon( .. )
    , Metric( .. )
    , (^*)
    , (^/)
    , normalize
    ) where

#ifdef EXTERNAL_LINEAR
-- We just reexport

import Linear
#else

import Graphics.Rasterific.MiniLens

infixl 6 ^+^, ^-^
infixl 7 ^*, ^/

-- | A 2-dimensional vector

--

-- >>> pure 1 :: V2 Int

-- V2 1 1

--

-- >>> V2 1 2 + V2 3 4

-- V2 4 6

--

-- >>> V2 1 2 * V2 3 4

-- V2 3 8

--

-- >>> sum (V2 1 2)

-- 3

data V2 a = V2 !a !a
    deriving (V2 a -> V2 a -> Bool
(V2 a -> V2 a -> Bool) -> (V2 a -> V2 a -> Bool) -> Eq (V2 a)
forall a. Eq a => V2 a -> V2 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V2 a -> V2 a -> Bool
$c/= :: forall a. Eq a => V2 a -> V2 a -> Bool
== :: V2 a -> V2 a -> Bool
$c== :: forall a. Eq a => V2 a -> V2 a -> Bool
Eq, Int -> V2 a -> ShowS
[V2 a] -> ShowS
V2 a -> String
(Int -> V2 a -> ShowS)
-> (V2 a -> String) -> ([V2 a] -> ShowS) -> Show (V2 a)
forall a. Show a => Int -> V2 a -> ShowS
forall a. Show a => [V2 a] -> ShowS
forall a. Show a => V2 a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V2 a] -> ShowS
$cshowList :: forall a. Show a => [V2 a] -> ShowS
show :: V2 a -> String
$cshow :: forall a. Show a => V2 a -> String
showsPrec :: Int -> V2 a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> V2 a -> ShowS
Show)

-- | A 3-dimensional vector

data V3 a = V3 !a !a !a
    deriving (V3 a -> V3 a -> Bool
(V3 a -> V3 a -> Bool) -> (V3 a -> V3 a -> Bool) -> Eq (V3 a)
forall a. Eq a => V3 a -> V3 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V3 a -> V3 a -> Bool
$c/= :: forall a. Eq a => V3 a -> V3 a -> Bool
== :: V3 a -> V3 a -> Bool
$c== :: forall a. Eq a => V3 a -> V3 a -> Bool
Eq, Int -> V3 a -> ShowS
[V3 a] -> ShowS
V3 a -> String
(Int -> V3 a -> ShowS)
-> (V3 a -> String) -> ([V3 a] -> ShowS) -> Show (V3 a)
forall a. Show a => Int -> V3 a -> ShowS
forall a. Show a => [V3 a] -> ShowS
forall a. Show a => V3 a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V3 a] -> ShowS
$cshowList :: forall a. Show a => [V3 a] -> ShowS
show :: V3 a -> String
$cshow :: forall a. Show a => V3 a -> String
showsPrec :: Int -> V3 a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> V3 a -> ShowS
Show)

-- | A 4-dimensional vector

data V4 a = V4 !a !a !a !a
    deriving (V4 a -> V4 a -> Bool
(V4 a -> V4 a -> Bool) -> (V4 a -> V4 a -> Bool) -> Eq (V4 a)
forall a. Eq a => V4 a -> V4 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V4 a -> V4 a -> Bool
$c/= :: forall a. Eq a => V4 a -> V4 a -> Bool
== :: V4 a -> V4 a -> Bool
$c== :: forall a. Eq a => V4 a -> V4 a -> Bool
Eq, Int -> V4 a -> ShowS
[V4 a] -> ShowS
V4 a -> String
(Int -> V4 a -> ShowS)
-> (V4 a -> String) -> ([V4 a] -> ShowS) -> Show (V4 a)
forall a. Show a => Int -> V4 a -> ShowS
forall a. Show a => [V4 a] -> ShowS
forall a. Show a => V4 a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V4 a] -> ShowS
$cshowList :: forall a. Show a => [V4 a] -> ShowS
show :: V4 a -> String
$cshow :: forall a. Show a => V4 a -> String
showsPrec :: Int -> V4 a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> V4 a -> ShowS
Show)

class R1 t where
  _x :: Lens' (t a) a

class R2 t where
  _y :: Lens' (t a) a

instance R1 V1 where
  _x :: (a -> f a) -> V1 a -> f (V1 a)
_x = (V1 a -> a) -> (V1 a -> a -> V1 a) -> Lens (V1 a) (V1 a) a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(V1 a
a) -> a
a) (\V1 a
_ -> a -> V1 a
forall a. a -> V1 a
V1)

instance R1 V2 where
  _x :: (a -> f a) -> V2 a -> f (V2 a)
_x = (V2 a -> a) -> (V2 a -> a -> V2 a) -> Lens (V2 a) (V2 a) a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(V2 a
x a
_) -> a
x) (\(V2 a
_ a
y) a
x -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
x a
y)

instance R2 V2 where
  _y :: (a -> f a) -> V2 a -> f (V2 a)
_y = (V2 a -> a) -> (V2 a -> a -> V2 a) -> Lens (V2 a) (V2 a) a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(V2 a
_ a
y) -> a
y) (\(V2 a
x a
_) a
y -> a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
x a
y)

instance R1 V3 where
  _x :: (a -> f a) -> V3 a -> f (V3 a)
_x = (V3 a -> a) -> (V3 a -> a -> V3 a) -> Lens (V3 a) (V3 a) a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(V3 a
x a
_ a
_) -> a
x) (\(V3 a
_ a
y a
z) a
x -> a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
x a
y a
z)

instance R2 V3 where
  _y :: (a -> f a) -> V3 a -> f (V3 a)
_y = (V3 a -> a) -> (V3 a -> a -> V3 a) -> Lens (V3 a) (V3 a) a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(V3 a
_ a
y a
_) -> a
y) (\(V3 a
x a
_ a
z) a
y -> a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
x a
y a
z)

instance R1 V4 where
  _x :: (a -> f a) -> V4 a -> f (V4 a)
_x = (V4 a -> a) -> (V4 a -> a -> V4 a) -> Lens (V4 a) (V4 a) a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(V4 a
x a
_ a
_ a
_) -> a
x) (\(V4 a
_ a
y a
z a
w) a
x -> a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
x a
y a
z a
w)

instance R2 V4 where
  _y :: (a -> f a) -> V4 a -> f (V4 a)
_y = (V4 a -> a) -> (V4 a -> a -> V4 a) -> Lens (V4 a) (V4 a) a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(V4 a
_ a
y a
_ a
_) -> a
y) (\(V4 a
x a
_ a
z a
w) a
y -> a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
x a
y a
z a
w)

-- | A 1-dimensional vector

newtype V1 a = V1 a
    deriving (V1 a -> V1 a -> Bool
(V1 a -> V1 a -> Bool) -> (V1 a -> V1 a -> Bool) -> Eq (V1 a)
forall a. Eq a => V1 a -> V1 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1 a -> V1 a -> Bool
$c/= :: forall a. Eq a => V1 a -> V1 a -> Bool
== :: V1 a -> V1 a -> Bool
$c== :: forall a. Eq a => V1 a -> V1 a -> Bool
Eq, Int -> V1 a -> ShowS
[V1 a] -> ShowS
V1 a -> String
(Int -> V1 a -> ShowS)
-> (V1 a -> String) -> ([V1 a] -> ShowS) -> Show (V1 a)
forall a. Show a => Int -> V1 a -> ShowS
forall a. Show a => [V1 a] -> ShowS
forall a. Show a => V1 a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V1 a] -> ShowS
$cshowList :: forall a. Show a => [V1 a] -> ShowS
show :: V1 a -> String
$cshow :: forall a. Show a => V1 a -> String
showsPrec :: Int -> V1 a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> V1 a -> ShowS
Show, Integer -> V1 a
V1 a -> V1 a
V1 a -> V1 a -> V1 a
(V1 a -> V1 a -> V1 a)
-> (V1 a -> V1 a -> V1 a)
-> (V1 a -> V1 a -> V1 a)
-> (V1 a -> V1 a)
-> (V1 a -> V1 a)
-> (V1 a -> V1 a)
-> (Integer -> V1 a)
-> Num (V1 a)
forall a. Num a => Integer -> V1 a
forall a. Num a => V1 a -> V1 a
forall a. Num a => V1 a -> V1 a -> V1 a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> V1 a
$cfromInteger :: forall a. Num a => Integer -> V1 a
signum :: V1 a -> V1 a
$csignum :: forall a. Num a => V1 a -> V1 a
abs :: V1 a -> V1 a
$cabs :: forall a. Num a => V1 a -> V1 a
negate :: V1 a -> V1 a
$cnegate :: forall a. Num a => V1 a -> V1 a
* :: V1 a -> V1 a -> V1 a
$c* :: forall a. Num a => V1 a -> V1 a -> V1 a
- :: V1 a -> V1 a -> V1 a
$c- :: forall a. Num a => V1 a -> V1 a -> V1 a
+ :: V1 a -> V1 a -> V1 a
$c+ :: forall a. Num a => V1 a -> V1 a -> V1 a
Num)

instance Functor V1 where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> V1 a -> V1 b
fmap a -> b
f (V1 a
a) = b -> V1 b
forall a. a -> V1 a
V1 (b -> V1 b) -> b -> V1 b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a

instance Functor V2 where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> V2 a -> V2 b
fmap a -> b
f (V2 a
a a
b) = b -> b -> V2 b
forall a. a -> a -> V2 a
V2 (a -> b
f a
a) (a -> b
f a
b)

instance Functor V3 where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> V3 a -> V3 b
fmap a -> b
f (V3 a
a a
b a
c) = b -> b -> b -> V3 b
forall a. a -> a -> a -> V3 a
V3 (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c)

instance Functor V4 where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> V4 a -> V4 b
fmap a -> b
f (V4 a
a a
b a
c a
d) = b -> b -> b -> b -> V4 b
forall a. a -> a -> a -> a -> V4 a
V4 (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c) (a -> b
f a
d)

instance Foldable V3 where
  foldMap :: (a -> m) -> V3 a -> m
foldMap a -> m
f (V3 a
a a
b a
c) = a -> m
f a
a m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
b m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
c
  {-# INLINE foldMap #-}

instance Traversable V3 where
  traverse :: (a -> f b) -> V3 a -> f (V3 b)
traverse a -> f b
f (V3 a
a a
b a
c) = b -> b -> b -> V3 b
forall a. a -> a -> a -> V3 a
V3 (b -> b -> b -> V3 b) -> f b -> f (b -> b -> V3 b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (b -> b -> V3 b) -> f b -> f (b -> V3 b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
b f (b -> V3 b) -> f b -> f (V3 b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
c
  {-# INLINE traverse #-}

instance Foldable V2 where
  foldMap :: (a -> m) -> V2 a -> m
foldMap a -> m
f (V2 a
a a
b) = a -> m
f a
a m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
b
  {-# INLINE foldMap #-}

instance Traversable V2 where
  traverse :: (a -> f b) -> V2 a -> f (V2 b)
traverse a -> f b
f (V2 a
a a
b) = b -> b -> V2 b
forall a. a -> a -> V2 a
V2 (b -> b -> V2 b) -> f b -> f (b -> V2 b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (b -> V2 b) -> f b -> f (V2 b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
b
  {-# INLINE traverse #-}

instance Foldable V4 where
  foldMap :: (a -> m) -> V4 a -> m
foldMap a -> m
f (V4 a
a a
b a
c a
d) = a -> m
f a
a m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
b m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
c m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
d
  {-# INLINE foldMap #-}

instance Traversable V4 where
  traverse :: (a -> f b) -> V4 a -> f (V4 b)
traverse a -> f b
f (V4 a
a a
b a
c a
d) = b -> b -> b -> b -> V4 b
forall a. a -> a -> a -> a -> V4 a
V4 (b -> b -> b -> b -> V4 b) -> f b -> f (b -> b -> b -> V4 b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (b -> b -> b -> V4 b) -> f b -> f (b -> b -> V4 b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
b f (b -> b -> V4 b) -> f b -> f (b -> V4 b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
c f (b -> V4 b) -> f b -> f (V4 b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
d
  {-# INLINE traverse #-}

instance Foldable V1 where
  foldMap :: (a -> m) -> V1 a -> m
foldMap a -> m
f (V1 a
a) = a -> m
f a
a
  {-# INLINE foldMap #-}

instance Traversable V1 where
  traverse :: (a -> f b) -> V1 a -> f (V1 b)
traverse a -> f b
f (V1 a
a) = b -> V1 b
forall a. a -> V1 a
V1 (b -> V1 b) -> f b -> f (V1 b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
  {-# INLINE traverse #-}

instance Num a => Num (V2 a) where
  (V2 a
a a
b) + :: V2 a -> V2 a -> V2 a
+ (V2 a
a' a
b') = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
a') (a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
b')
  {-# INLINE (+) #-}
  (V2 a
a a
b) - :: V2 a -> V2 a -> V2 a
- (V2 a
a' a
b') = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
a') (a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
b')
  {-# INLINE (-) #-}
  (V2 a
a a
b) * :: V2 a -> V2 a -> V2 a
* (V2 a
a' a
b') = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
a') (a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
b')
  {-# INLINE (*) #-}
  negate :: V2 a -> V2 a
negate (V2 a
a a
b) = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a -> a
forall a. Num a => a -> a
negate a
a) (a -> a
forall a. Num a => a -> a
negate a
b)
  {-# INLINE negate #-}
  abs :: V2 a -> V2 a
abs (V2 a
a a
b) = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a -> a
forall a. Num a => a -> a
abs a
a) (a -> a
forall a. Num a => a -> a
abs a
b)
  {-# INLINE abs #-}
  signum :: V2 a -> V2 a
signum (V2 a
a a
b) = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a -> a
forall a. Num a => a -> a
signum a
a) (a -> a
forall a. Num a => a -> a
signum a
b)
  {-# INLINE signum #-}
  fromInteger :: Integer -> V2 a
fromInteger = a -> V2 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> V2 a) -> (Integer -> a) -> Integer -> V2 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
  {-# INLINE fromInteger #-}

instance Num a => Num (V3 a) where
  (V3 a
a a
b a
c) + :: V3 a -> V3 a -> V3 a
+ (V3 a
a' a
b' a
c') = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
a') (a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
b') (a
c a -> a -> a
forall a. Num a => a -> a -> a
+ a
c')
  {-# INLINE (+) #-}
  (V3 a
a a
b a
c) - :: V3 a -> V3 a -> V3 a
- (V3 a
a' a
b' a
c') = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
a') (a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
b') (a
c a -> a -> a
forall a. Num a => a -> a -> a
- a
c')
  {-# INLINE (-) #-}
  (V3 a
a a
b a
c) * :: V3 a -> V3 a -> V3 a
* (V3 a
a' a
b' a
c') = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 (a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
a') (a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
b') (a
c a -> a -> a
forall a. Num a => a -> a -> a
* a
c')
  {-# INLINE (*) #-}
  negate :: V3 a -> V3 a
negate (V3 a
a a
b a
c) = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 (a -> a
forall a. Num a => a -> a
negate a
a) (a -> a
forall a. Num a => a -> a
negate a
b) (a -> a
forall a. Num a => a -> a
negate a
c)
  {-# INLINE negate #-}
  abs :: V3 a -> V3 a
abs (V3 a
a a
b a
c) = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 (a -> a
forall a. Num a => a -> a
abs a
a) (a -> a
forall a. Num a => a -> a
abs a
b) (a -> a
forall a. Num a => a -> a
abs a
c)
  {-# INLINE abs #-}
  signum :: V3 a -> V3 a
signum (V3 a
a a
b a
c) = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 (a -> a
forall a. Num a => a -> a
signum a
a) (a -> a
forall a. Num a => a -> a
signum a
b) (a -> a
forall a. Num a => a -> a
signum a
c)
  {-# INLINE signum #-}
  fromInteger :: Integer -> V3 a
fromInteger = a -> V3 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> V3 a) -> (Integer -> a) -> Integer -> V3 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
  {-# INLINE fromInteger #-}

instance Num a => Num (V4 a) where
  (V4 a
a a
b a
c a
d) + :: V4 a -> V4 a -> V4 a
+ (V4 a
a' a
b' a
c' a
d') = a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
a') (a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
b') (a
c a -> a -> a
forall a. Num a => a -> a -> a
+ a
c') (a
d a -> a -> a
forall a. Num a => a -> a -> a
+ a
d')
  {-# INLINE (+) #-}
  (V4 a
a a
b a
c a
d) - :: V4 a -> V4 a -> V4 a
- (V4 a
a' a
b' a
c' a
d') = a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
a') (a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
b') (a
c a -> a -> a
forall a. Num a => a -> a -> a
- a
c') (a
d a -> a -> a
forall a. Num a => a -> a -> a
- a
d')
  {-# INLINE (-) #-}
  (V4 a
a a
b a
c a
d) * :: V4 a -> V4 a -> V4 a
* (V4 a
a' a
b' a
c' a
d') = a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 (a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
a') (a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
b') (a
c a -> a -> a
forall a. Num a => a -> a -> a
* a
c') (a
d a -> a -> a
forall a. Num a => a -> a -> a
* a
d')
  {-# INLINE (*) #-}
  negate :: V4 a -> V4 a
negate (V4 a
a a
b a
c a
d) = a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 (a -> a
forall a. Num a => a -> a
negate a
a) (a -> a
forall a. Num a => a -> a
negate a
b) (a -> a
forall a. Num a => a -> a
negate a
c) (a -> a
forall a. Num a => a -> a
negate a
d)
  {-# INLINE negate #-}
  abs :: V4 a -> V4 a
abs (V4 a
a a
b a
c a
d) = a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 (a -> a
forall a. Num a => a -> a
abs a
a) (a -> a
forall a. Num a => a -> a
abs a
b) (a -> a
forall a. Num a => a -> a
abs a
c) (a -> a
forall a. Num a => a -> a
abs a
d)
  {-# INLINE abs #-}
  signum :: V4 a -> V4 a
signum (V4 a
a a
b a
c a
d) = a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 (a -> a
forall a. Num a => a -> a
signum a
a) (a -> a
forall a. Num a => a -> a
signum a
b) (a -> a
forall a. Num a => a -> a
signum a
c) (a -> a
forall a. Num a => a -> a
signum a
d)
  {-# INLINE signum #-}
  fromInteger :: Integer -> V4 a
fromInteger = a -> V4 a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> V4 a) -> (Integer -> a) -> Integer -> V4 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
  {-# INLINE fromInteger #-}

instance Applicative V4 where
    {-# INLINE pure #-}
    pure :: a -> V4 a
pure a
a = a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
a a
a a
a a
a
    {-# INLINE (<*>) #-}
    (V4 a -> b
f1 a -> b
f2 a -> b
f3 a -> b
f4) <*> :: V4 (a -> b) -> V4 a -> V4 b
<*> (V4 a
a a
b a
c a
d) = b -> b -> b -> b -> V4 b
forall a. a -> a -> a -> a -> V4 a
V4 (a -> b
f1 a
a) (a -> b
f2 a
b) (a -> b
f3 a
c) (a -> b
f4 a
d)

instance Applicative V3 where
    {-# INLINE pure #-}
    pure :: a -> V3 a
pure a
a = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
a a
a a
a
    {-# INLINE (<*>) #-}
    (V3 a -> b
f1 a -> b
f2 a -> b
f3) <*> :: V3 (a -> b) -> V3 a -> V3 b
<*> (V3 a
a a
b a
c) = b -> b -> b -> V3 b
forall a. a -> a -> a -> V3 a
V3 (a -> b
f1 a
a) (a -> b
f2 a
b) (a -> b
f3 a
c)

instance Applicative V2 where
    {-# INLINE pure #-}
    pure :: a -> V2 a
pure a
a = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
a a
a
    {-# INLINE (<*>) #-}
    (V2 a -> b
f1 a -> b
f2) <*> :: V2 (a -> b) -> V2 a -> V2 b
<*> (V2 a
a a
b) = b -> b -> V2 b
forall a. a -> a -> V2 a
V2 (a -> b
f1 a
a) (a -> b
f2 a
b)

instance Applicative V1 where
    {-# INLINE pure #-}
    pure :: a -> V1 a
pure = a -> V1 a
forall a. a -> V1 a
V1 
    {-# INLINE (<*>) #-}
    (V1 a -> b
f) <*> :: V1 (a -> b) -> V1 a -> V1 b
<*> (V1 a
v) = b -> V1 b
forall a. a -> V1 a
V1 (b -> V1 b) -> b -> V1 b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
v

-- | A vector is an additive group with additional structure.

class Functor f => Additive f where
  -- | The zero vector

  zero :: Num a => f a
  -- | Compute the sum of two vectors

  --

  -- >>> V2 1 2 ^+^ V2 3 4

  -- V2 4 6

  (^+^) :: Num a => f a -> f a -> f a

  -- | Compute the difference between two vectors

  --

  -- >>> V2 4 5 - V2 3 1

  -- V2 1 4

  (^-^) :: Num a => f a -> f a -> f a

  -- | Linearly interpolate between two vectors.

  lerp :: Num a => a -> f a -> f a -> f a

-- | Provides a fairly subjective test to see if a quantity is near zero.

--

-- >>> nearZero (1e-11 :: Double)

-- False

--

-- >>> nearZero (1e-17 :: Double)

-- True

--

-- >>> nearZero (1e-5 :: Float)

-- False

--

-- >>> nearZero (1e-7 :: Float)

-- True

class Num a => Epsilon a where
  -- | Determine if a quantity is near zero.

  nearZero :: a -> Bool

-- | @'abs' a '<=' 1e-6@

instance Epsilon Float where
  nearZero :: Float -> Bool
nearZero Float
a = Float -> Float
forall a. Num a => a -> a
abs Float
a Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
1e-6
  {-# INLINE nearZero #-}

-- | @'abs' a '<=' 1e-12@

instance Epsilon Double where
  nearZero :: Double -> Bool
nearZero Double
a = Double -> Double
forall a. Num a => a -> a
abs Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
1e-12
  {-# INLINE nearZero #-}

instance Epsilon a => Epsilon (V4 a) where
  nearZero :: V4 a -> Bool
nearZero = a -> Bool
forall a. Epsilon a => a -> Bool
nearZero (a -> Bool) -> (V4 a -> a) -> V4 a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V4 a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance
  {-# INLINE nearZero #-}

instance Epsilon a => Epsilon (V3 a) where
  nearZero :: V3 a -> Bool
nearZero = a -> Bool
forall a. Epsilon a => a -> Bool
nearZero (a -> Bool) -> (V3 a -> a) -> V3 a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V3 a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance
  {-# INLINE nearZero #-}

instance Epsilon a => Epsilon (V2 a) where
  nearZero :: V2 a -> Bool
nearZero = a -> Bool
forall a. Epsilon a => a -> Bool
nearZero (a -> Bool) -> (V2 a -> a) -> V2 a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance
  {-# INLINE nearZero #-}

instance Epsilon a => Epsilon (V1 a) where
  nearZero :: V1 a -> Bool
nearZero (V1 a
a) = a -> Bool
forall a. Epsilon a => a -> Bool
nearZero a
a
  {-# INLINE nearZero #-}

instance Additive V4 where
    zero :: V4 a
zero = a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 a
0 a
0
    {-# INLINE zero #-}

    (V4 a
a a
b a
c a
d) ^+^ :: V4 a -> V4 a -> V4 a
^+^ (V4 a
a' a
b' a
c' a
d') = a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
a') (a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
b') (a
c a -> a -> a
forall a. Num a => a -> a -> a
+ a
c') (a
d a -> a -> a
forall a. Num a => a -> a -> a
+ a
d')
    {-# INLINE (^+^) #-}

    (V4 a
a a
b a
c a
d) ^-^ :: V4 a -> V4 a -> V4 a
^-^ (V4 a
a' a
b' a
c' a
d') = a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
a') (a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
b') (a
c a -> a -> a
forall a. Num a => a -> a -> a
+ a
c') (a
d a -> a -> a
forall a. Num a => a -> a -> a
+ a
d')
    {-# INLINE (^-^) #-}
    lerp :: a -> V4 a -> V4 a -> V4 a
lerp a
alpha V4 a
u V4 a
v = V4 a
u V4 a -> a -> V4 a
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* a
alpha V4 a -> V4 a -> V4 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ V4 a
v V4 a -> a -> V4 a
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
alpha)
    {-# INLINE lerp #-}

instance Additive V3 where
    zero :: V3 a
zero = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
0 a
0 a
0
    {-# INLINE zero #-}

    (V3 a
a a
b a
c) ^+^ :: V3 a -> V3 a -> V3 a
^+^ (V3 a
a' a
b' a
c') = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
a') (a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
b') (a
c a -> a -> a
forall a. Num a => a -> a -> a
+ a
c')
    {-# INLINE (^+^) #-}

    (V3 a
a a
b a
c) ^-^ :: V3 a -> V3 a -> V3 a
^-^ (V3 a
a' a
b' a
c') = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
a') (a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
b') (a
c a -> a -> a
forall a. Num a => a -> a -> a
+ a
c')
    {-# INLINE (^-^) #-}

    lerp :: a -> V3 a -> V3 a -> V3 a
lerp a
alpha V3 a
u V3 a
v = V3 a
u V3 a -> a -> V3 a
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* a
alpha V3 a -> V3 a -> V3 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ V3 a
v V3 a -> a -> V3 a
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
alpha)
    {-# INLINE lerp #-}

instance Additive V2 where
    zero :: V2 a
zero = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
0 a
0
    {-# INLINE zero #-}

    (V2 a
a a
b) ^+^ :: V2 a -> V2 a -> V2 a
^+^ (V2 a
a' a
b') = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
a') (a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
b')
    {-# INLINE (^+^) #-}

    (V2 a
a a
b) ^-^ :: V2 a -> V2 a -> V2 a
^-^ (V2 a
a' a
b') = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
a') (a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
b')
    {-# INLINE (^-^) #-}

    lerp :: a -> V2 a -> V2 a -> V2 a
lerp a
alpha V2 a
u V2 a
v = V2 a
u V2 a -> a -> V2 a
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* a
alpha V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ V2 a
v V2 a -> a -> V2 a
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
alpha)
    {-# INLINE lerp #-}

instance Additive V1 where
    zero :: V1 a
zero = a -> V1 a
forall a. a -> V1 a
V1 a
0
    {-# INLINE zero #-}

    (V1 a
a) ^+^ :: V1 a -> V1 a -> V1 a
^+^ (V1 a
a') = a -> V1 a
forall a. a -> V1 a
V1 (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
a')
    {-# INLINE (^+^) #-}

    (V1 a
a) ^-^ :: V1 a -> V1 a -> V1 a
^-^ (V1 a
a') = a -> V1 a
forall a. a -> V1 a
V1 (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
a')
    {-# INLINE (^-^) #-}

    lerp :: a -> V1 a -> V1 a -> V1 a
lerp a
alpha V1 a
u V1 a
v = V1 a
u V1 a -> a -> V1 a
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* a
alpha V1 a -> V1 a -> V1 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ V1 a
v V1 a -> a -> V1 a
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
alpha)
    {-# INLINE lerp #-}

-- | Free and sparse inner product/metric spaces.

class Additive f => Metric f where
  -- | Compute the inner product of two vectors or (equivalently)

  -- convert a vector @f a@ into a covector @f a -> a@.

  --

  -- >>> V2 1 2 `dot` V2 3 4

  -- 11

  dot :: Num a => f a -> f a -> a

  -- | Compute the squared norm. The name quadrance arises from

  -- Norman J. Wildberger's rational trigonometry.

  quadrance :: Num a => f a -> a
  {-# INLINE quadrance #-}
  quadrance f a
v = f a -> f a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
dot f a
v f a
v

  -- | Compute the quadrance of the difference

  qd :: Num a => f a -> f a -> a
  {-# INLINE qd #-}
  qd f a
f f a
g = f a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance (f a
f f a -> f a -> f a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ f a
g)

  -- | Compute the distance between two vectors in a metric space

  distance :: Floating a => f a -> f a -> a
  {-# INLINE distance #-}
  distance f a
f f a
g = f a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm (f a
f f a -> f a -> f a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ f a
g)

  -- | Compute the norm of a vector in a metric space

  norm :: Floating a => f a -> a
  {-# INLINE norm #-}
  norm f a
v = a -> a
forall a. Floating a => a -> a
sqrt (f a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance f a
v)

  -- | Convert a non-zero vector to unit vector.

  signorm :: Floating a => 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
/ a
m) f a
v where
    m :: a
m = f a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm f a
v

instance Metric V4 where
    dot :: V4 a -> V4 a -> a
dot (V4 a
a a
b a
c a
d) (V4 a
a' a
b' a
c' a
d') = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
a' a -> a -> a
forall a. Num a => a -> a -> a
+ a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
b' a -> a -> a
forall a. Num a => a -> a -> a
+ a
c a -> a -> a
forall a. Num a => a -> a -> a
* a
c' a -> a -> a
forall a. Num a => a -> a -> a
+ a
d a -> a -> a
forall a. Num a => a -> a -> a
* a
d'
    {-# INLINE dot #-}

    quadrance :: V4 a -> a
quadrance (V4 a
a a
b a
c a
d) = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
c a -> a -> a
forall a. Num a => a -> a -> a
* a
c a -> a -> a
forall a. Num a => a -> a -> a
+ a
d a -> a -> a
forall a. Num a => a -> a -> a
* a
d
    {-# INLINE quadrance #-}

    norm :: V4 a -> a
norm V4 a
v = a -> a
forall a. Floating a => a -> a
sqrt (V4 a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance V4 a
v)
    {-# INLINE norm #-}

instance Metric V3 where
    dot :: V3 a -> V3 a -> a
dot (V3 a
a a
b a
c) (V3 a
a' a
b' a
c') = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
a' a -> a -> a
forall a. Num a => a -> a -> a
+ a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
b' a -> a -> a
forall a. Num a => a -> a -> a
+ a
c a -> a -> a
forall a. Num a => a -> a -> a
* a
c'
    {-# INLINE dot #-}

    quadrance :: V3 a -> a
quadrance (V3 a
a a
b a
c) = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
c a -> a -> a
forall a. Num a => a -> a -> a
* a
c
    {-# INLINE quadrance #-}

    norm :: V3 a -> a
norm V3 a
v = a -> a
forall a. Floating a => a -> a
sqrt (V3 a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance V3 a
v)
    {-# INLINE norm #-}

instance Metric V2 where
    dot :: V2 a -> V2 a -> a
dot (V2 a
a a
b) (V2 a
a' a
b') = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
a' a -> a -> a
forall a. Num a => a -> a -> a
+ a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
b'
    {-# INLINE dot #-}

    quadrance :: V2 a -> a
quadrance (V2 a
a a
b) = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
b
    {-# INLINE quadrance #-}

    norm :: V2 a -> a
norm V2 a
v = a -> a
forall a. Floating a => a -> a
sqrt (V2 a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance V2 a
v)
    {-# INLINE norm #-}

-- | Compute the right scalar product

--

-- >>> V2 3 4 ^* 2

-- V2 6 8

(^*) :: (Functor f, Num a) => f a -> a -> f a
{-# INLINE (^*) #-}
^* :: f a -> a -> f a
(^*) f a
f a
n = (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
n) f a
f

-- | Compute division by a scalar on the right.

(^/) :: (Functor f, Floating a) => f a -> a -> f a
{-# INLINE (^/) #-}
^/ :: f a -> a -> f a
(^/) f a
f a
n = (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
n) f a
f

-- | Normalize a 'Metric' functor to have unit 'norm'. This function

-- does not change the functor if its 'norm' is 0 or 1.

normalize :: (Floating a, Metric f, Epsilon a) => f a -> f a
{-# INLINE normalize #-}
normalize :: f a -> f a
normalize f a
v = if a -> Bool
forall a. Epsilon a => a -> Bool
nearZero a
l Bool -> Bool -> Bool
|| a -> Bool
forall a. Epsilon a => a -> Bool
nearZero (a
1a -> a -> a
forall a. Num a => a -> a -> a
-a
l) then f a
v
             else (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
forall a. Floating a => a -> a
sqrt a
l) f a
v
  where l :: a
l = f a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance f a
v

#endif