{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Vector.Class
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- A Class defining d-dimensional vectors
--
--------------------------------------------------------------------------------
module HGeometry.Vector.Class
  ( AsVector_(..)
  , Vector_(..) --, pattern Vector1_, pattern Vector2_, pattern Vector3_, pattern Vector4_
  , Has_
  , generate, vectorFromList
  , component
  , xComponent, yComponent, zComponent, wComponent
  -- , head, last
  -- , HasComponents(..), components1

  -- , ConstructVector, ConstructableVector_(..)

  -- , vectorFromVector
  , prefix, suffix
  , cons, snoc
  , uncons, unsnoc
  -- , vZipWith

  , Additive_(..), zero, liftI2, lerp, (^+^), (^-^)
  , negated, (*^), (^*), (^/), sumV, basis, unit
  , foldMapZip
  , Metric_(..)
  -- , VectorFor
  ) where

-- import           Control.Arrow ((&&&))
import           Control.Lens hiding (cons,snoc,uncons,unsnoc)
import           Control.Monad.State
import           Control.Monad (guard, replicateM)
import qualified Data.Foldable as F
import qualified Data.Functor.Apply as Apply
import           Data.Functor.Classes (readData, readUnaryWith)
-- import           Data.Maybe (fromMaybe)
import           Data.Proxy
import           Data.Type.Ord
import           GHC.TypeNats
import           HGeometry.Properties
import           HGeometry.Vector.Type
import           Text.Read (Read (..))
-- import           HGeometry.Vector.Additive
-- import           HGeometry.Vector.Metric
import qualified Linear.V1 as Linear
import qualified Linear.V2 as Linear
import qualified Linear.V3 as Linear
import qualified Linear.V4 as Linear
import           Prelude hiding (zipWith, head, last)
import           System.Random (Random (..))
import           System.Random.Stateful (UniformRange(..), Uniform(..), isInRangeOrd)
import qualified HGeometry.Number.Radical as Radical

--------------------------------------------------------------------------------


{- $setup
>>> import HGeometry.Vector
>>> import Data.Semigroup
>>> let myVec2 = Vector2 10 20 :: Vector 2 Int
>>> let myVec3 = Vector3 1 2 3 :: Vector 3 Int
-}

--------------------------------------------------------------------------------
{-
-- | A class for types that are isomorphic to d-dimensional vectors
class ( r ~ IxValue vector
      , d ~ Dimension vector
      ) => AsVector_ vector d r | vector -> d
                                , vector -> r  where
  -- | Convert into a 'Vector d r'.
  _Vector' :: Iso' vector (Vector d r)
  default _Vector' :: ( Vector_ (Vector d r) d r
                     , Vector_ vector       d r
                     ) => Iso' vector (Vector d r)
  _Vector' = _Vector
  {-# INLINE _Vector' #-}
-}

-- | Types that can be converted to and from our canonical 'Vector d r' type
class ( r ~ IxValue vector
      , s ~ IxValue vector'
      , d ~ Dimension vector
      , d ~ Dimension vector'
      ) =>  AsVector_ vector vector' d r s | vector -> d
                                           , vector -> r
                                           , vector' -> s  where
  -- | Convert from a 'Vector d r' and into a 'Vector d s'
  _Vector :: Iso vector vector' (Vector d r) (Vector d s)

instance AsVector_ (Vector d r) (Vector d s) d r s where
  _Vector :: Iso (Vector d r) (Vector d s) (Vector d r) (Vector d s)
_Vector = p (Vector d r) (f (Vector d s)) -> p (Vector d r) (f (Vector d s))
forall a. a -> a
id
  {-# INLINE _Vector #-}

-- -- | An iso to convert between an arbitrary vector type, and the
-- -- specific vector type implemented in HGeometry.Vector
-- _Vector :: ( Vector_ (Vector d r) d r
--            , Vector_ vector       d r
--            , Vector_ vector'      d s
--            , Vector_ (Vector d s) d s
--            ) => Iso vector vector' (Vector d r) (Vector d s)
-- _Vector = iso (\v -> generate (\i -> v^?!component' i))
--               (\v -> generate (\i -> v^?!component' i))
-- {-# INLINE _Vector #-}


-- instance AsVector_ (Vector d r) d r where
--   _Vector' = id
--   {-# INLINE _Vector' #-}

-- | Class for representing d dimensional vectors.
class ( HasComponents vector vector
      , AsVector_ vector vector d r r
      , KnownNat d
      ) => Vector_ vector d r where
  {-# MINIMAL generateA #-}

  -- | Generates a vector from an Applicative operation (that takes the
  -- index)
  generateA :: Applicative f => (Int -> f r) -> f vector

  -- | traversal to access the i^th coordinate.
  component' :: Int -> IndexedTraversal' Int vector r
  default component' :: (Index vector ~ Int, Ixed vector)
                          => Int -> IndexedTraversal' Int vector r
  component' = Int -> IndexedTraversal' Int vector r
Index vector
-> IndexedTraversal' (Index vector) vector (IxValue vector)
forall m.
Ixed m =>
Index m -> IndexedTraversal' (Index m) m (IxValue m)
iix
  {-# INLINE component' #-}

-- | Specifies that we have an appropriate constraint for the vector implementation
type Has_ c d r = c (Vector d r) d r

----------------------------------------

-- | Generate a vector from a given function.
generate   :: Vector_ vector d r => (Int -> r) -> vector
generate :: forall vector (d :: Nat) r.
Vector_ vector d r =>
(Int -> r) -> vector
generate Int -> r
f = Identity vector -> vector
forall a. Identity a -> a
runIdentity (Identity vector -> vector) -> Identity vector -> vector
forall a b. (a -> b) -> a -> b
$ (Int -> Identity r) -> Identity vector
forall vector (d :: Nat) r (f :: * -> *).
(Vector_ vector d r, Applicative f) =>
(Int -> f r) -> f vector
forall (f :: * -> *). Applicative f => (Int -> f r) -> f vector
generateA (r -> Identity r
forall a. a -> Identity a
Identity (r -> Identity r) -> (Int -> r) -> Int -> Identity r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> r
f)
{-# INLINE generate #-}

-- | Convert a list of exactly d elements into a vector with dimension d.
--
-- >>> vectorFromList [10,2,3] :: Maybe (Vector 3 Int)
-- Just (Vector3 10 2 3)
-- >>> vectorFromList [10,2,3,5] :: Maybe (Vector 3 Int)
-- Nothing
-- >>> vectorFromList [10,2] :: Maybe (Vector 3 Int)
-- Nothing
vectorFromList :: Vector_ vector d r => [r] -> Maybe vector
vectorFromList :: forall vector (d :: Nat) r.
Vector_ vector d r =>
[r] -> Maybe vector
vectorFromList = StateT [r] Maybe vector -> [r] -> Maybe vector
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT [r] Maybe vector -> [r] -> Maybe vector)
-> StateT [r] Maybe vector -> [r] -> Maybe vector
forall a b. (a -> b) -> a -> b
$ do v <- (Int -> StateT [r] Maybe r) -> StateT [r] Maybe vector
forall vector (d :: Nat) r (f :: * -> *).
(Vector_ vector d r, Applicative f) =>
(Int -> f r) -> f vector
forall (f :: * -> *). Applicative f => (Int -> f r) -> f vector
generateA Int -> StateT [r] Maybe r
forall r. Int -> StateT [r] Maybe r
next
                                 rest <- get
                                 guard (null rest)
                                 pure v
  where
    -- Note that this depends on the specific order in which we evaluate
    -- elements in generateA, so arguably this is somewhat dangerous.
    next   :: Int -> StateT [r] Maybe r
    next :: forall r. Int -> StateT [r] Maybe r
next Int
_ = StateT [r] Maybe [r]
forall s (m :: * -> *). MonadState s m => m s
get StateT [r] Maybe [r]
-> ([r] -> StateT [r] Maybe r) -> StateT [r] Maybe r
forall a b.
StateT [r] Maybe a
-> (a -> StateT [r] Maybe b) -> StateT [r] Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
               []   -> String -> StateT [r] Maybe r
forall a. String -> StateT [r] Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"vectorFromList: no next element"
               r
x:[r]
xs -> do [r] -> StateT [r] Maybe ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [r]
xs
                          r -> StateT [r] Maybe r
forall a. a -> StateT [r] Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
x
{-# INLINE vectorFromList #-}

-- -- | Construct a vector from a list of exactly d components. Crashes
-- -- when we get the wrong number of components.
-- uncheckedVectorFromList :: Vector_ vector d r => [r] -> vector
-- uncheckedVectorFromList = fromMaybe (error "uncheckedVectorFromList") . vectorFromList
-- {-# INLINE uncheckedVectorFromList #-}

----------------------------------------

-- | Lens to access te i^t component.
--
-- >>> myVec3 ^. component @0
-- 1
-- >>> myVec3 ^. component @1
-- 2
-- >>> myVec3 & component @1 %~ (*5)
-- Vector3 1 10 3
-- >>> myVec2 & component @1 %~ (*5)
-- Vector2 10 100
component :: forall i vector r d.
             (i <= d-1, KnownNat i, Vector_ vector d r)
          => IndexedLens' Int vector r
component :: forall (i :: Nat) vector r (d :: Nat).
(i <= (d - 1), KnownNat i, Vector_ vector d r) =>
IndexedLens' Int vector r
component = Traversing p f vector vector r r -> Over p f vector vector r r
forall (p :: * -> * -> *) (f :: * -> *) s t a.
(HasCallStack, Conjoined p, Functor f) =>
Traversing p f s t a a -> Over p f s t a a
singular (Traversing p f vector vector r r -> Over p f vector vector r r)
-> Traversing p f vector vector r r -> Over p f vector vector r r
forall a b. (a -> b) -> a -> b
$ Int -> IndexedTraversal' Int vector r
forall vector (d :: Nat) r.
Vector_ vector d r =>
Int -> IndexedTraversal' Int vector r
component' (Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Nat -> Int) -> (Proxy i -> Nat) -> Proxy i -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy i -> Nat
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (Proxy i -> Int) -> Proxy i -> Int
forall a b. (a -> b) -> a -> b
$ forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @i)
{-# INLINE component #-}

-- | Shorthand for accessing the x-component
--
-- >>> Vector3 1 2 3 ^. xComponent
-- 1
-- >>> Vector2 1 2 & xComponent .~ 10
-- Vector2 10 2
xComponent :: (Vector_ vector d r, 0 <= d - 1)
           => IndexedLens' Int vector r
xComponent :: forall vector (d :: Nat) r.
(Vector_ vector d r, 0 <= (d - 1)) =>
IndexedLens' Int vector r
xComponent = forall (i :: Nat) vector r (d :: Nat).
(i <= (d - 1), KnownNat i, Vector_ vector d r) =>
IndexedLens' Int vector r
component @0
{-# INLINE xComponent #-}

-- | Shorthand for accessing the y-component
--
-- >>> Vector3 1 2 3 ^. yComponent
-- 2
-- >>> Vector2 1 2 & yComponent .~ 10
-- Vector2 1 10
yComponent :: (Vector_ vector d r, 1 <= d - 1)
           => IndexedLens' Int vector r
yComponent :: forall vector (d :: Nat) r.
(Vector_ vector d r, 1 <= (d - 1)) =>
IndexedLens' Int vector r
yComponent = forall (i :: Nat) vector r (d :: Nat).
(i <= (d - 1), KnownNat i, Vector_ vector d r) =>
IndexedLens' Int vector r
component @1
{-# INLINE yComponent #-}

-- | Shorthand for accessing the z-component
--
-- >>> Vector3 1 2 3 ^. zComponent
-- 3
-- >>> Vector3 1 2 3 & zComponent .~ 10
-- Vector3 1 2 10
zComponent :: (Vector_ vector d r, 2 <= d - 1)
           => IndexedLens' Int vector r
zComponent :: forall vector (d :: Nat) r.
(Vector_ vector d r, 2 <= (d - 1)) =>
IndexedLens' Int vector r
zComponent = forall (i :: Nat) vector r (d :: Nat).
(i <= (d - 1), KnownNat i, Vector_ vector d r) =>
IndexedLens' Int vector r
component @2
{-# INLINE zComponent #-}

-- | Shorthand for accessing the w-component
--
-- >>> Vector4 1 2 3 4 ^. wComponent
-- 4
-- >>> Vector4 1 2 3 4 & wComponent .~ 10
-- Vector4 1 2 3 10
wComponent :: (Vector_ vector d r, 3 <= d - 1)
           => IndexedLens' Int vector r
wComponent :: forall vector (d :: Nat) r.
(Vector_ vector d r, 3 <= (d - 1)) =>
IndexedLens' Int vector r
wComponent = forall (i :: Nat) vector r (d :: Nat).
(i <= (d - 1), KnownNat i, Vector_ vector d r) =>
IndexedLens' Int vector r
component @3
{-# INLINE wComponent #-}

{-
-- | Lens to access the first element of the vector
head :: forall vector d r. (Vector_ vector d r, 1 <= d) => IndexedLens' Int vector r
head = xComponent

-- | Lens to access the last element of the vector
last :: forall vector d r. (Vector_ vector d r, 1 <= d) => IndexedLens' Int vector r
last = component @(d-1)
-}

--------------------------------------------------------------------------------

-- | Take a prefix of length i of the vector
--
-- >>> prefix myVec3 :: Vector 2 Int
-- Vector2 1 2
prefix   :: forall i d vector vector' r. ( i <= d
                                         , Vector_ vector  d r
                                         , Vector_ vector' i r
                                         )
         => vector -> vector'
prefix :: forall (i :: Nat) (d :: Nat) vector vector' r.
(i <= d, Vector_ vector d r, Vector_ vector' i r) =>
vector -> vector'
prefix vector
v = (Int -> r) -> vector'
forall vector (d :: Nat) r.
Vector_ vector d r =>
(Int -> r) -> vector
generate (\Int
i -> vector
vvector -> Getting (Endo r) vector r -> r
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!Int -> IndexedTraversal' Int vector r
forall vector (d :: Nat) r.
Vector_ vector d r =>
Int -> IndexedTraversal' Int vector r
component' Int
i)
{-# INLINE prefix #-}

-- | Take a suffix of length i  of the vector
--
-- >>> suffix @_ @_ @_ @(Vector 2 Int) myVec3
-- Vector2 2 3
suffix   :: forall i d vector vector' r. ( i <= d
                                       , Vector_ vector  d r
                                       , Vector_ vector' i r
                                       )
         => vector -> vector'
suffix :: forall (i :: Nat) (d :: Nat) vector vector' r.
(i <= d, Vector_ vector d r, Vector_ vector' i r) =>
vector -> vector'
suffix vector
v = let d :: Int
d = Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Nat -> Int) -> (Proxy d -> Nat) -> Proxy d -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy d -> Nat
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (Proxy d -> Int) -> Proxy d -> Int
forall a b. (a -> b) -> a -> b
$ forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @d
               s :: Int
s = Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Nat -> Int) -> (Proxy i -> Nat) -> Proxy i -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy i -> Nat
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (Proxy i -> Int) -> Proxy i -> Int
forall a b. (a -> b) -> a -> b
$ forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @i)
           in (Int -> r) -> vector'
forall vector (d :: Nat) r.
Vector_ vector d r =>
(Int -> r) -> vector
generate (\Int
j -> vector
vvector -> Getting (Endo r) vector r -> r
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!Int -> IndexedTraversal' Int vector r
forall vector (d :: Nat) r.
Vector_ vector d r =>
Int -> IndexedTraversal' Int vector r
component' (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j))
{-# INLINE suffix #-}

--------------------------------------------------------------------------------

-- | Class that supports additive opreations on vectors
class Vector_ vector d r => Additive_ vector d r where
  -- | Apply a function to merge the 'non-zero' components of two
  -- vectors, unioning the rest of the values.
  liftU2 :: (r -> r -> r) -> vector -> vector -> vector

  -- | Apply an Applicative function to the components of two vectors.
  liftI2A :: Apply.Apply f => (r -> r -> f r) -> vector -> vector -> f vector

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

-- | zero vector
zero :: (Num r, Additive_ vector d r) => vector
zero :: forall r vector (d :: Nat). (Num r, Additive_ vector d r) => vector
zero = (Int -> r) -> vector
forall vector (d :: Nat) r.
Vector_ vector d r =>
(Int -> r) -> vector
generate (r -> Int -> r
forall a b. a -> b -> a
const r
0)
{-# INLINE zero #-}

-- | add two vectors
(^+^)   :: (Num r, Additive_ vector d r) => vector -> vector -> vector
vector
u ^+^ :: forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
^+^ vector
v = (r -> r -> r) -> vector -> vector -> vector
forall vector (d :: Nat) r.
Additive_ vector d r =>
(r -> r -> r) -> vector -> vector -> vector
liftU2 r -> r -> r
forall a. Num a => a -> a -> a
(+) vector
u vector
v
{-# INLINE (^+^) #-}

-- | subtract vectors
(^-^)   :: (Num r, Additive_ vector d r) => vector -> vector -> vector
vector
u ^-^ :: forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
^-^ vector
v = vector
u vector -> vector -> vector
forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
^+^ vector -> vector
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> vector
negated vector
v
{-# INLINE (^-^) #-}

-- | Linearly interpolate between the two vectors
lerp           :: (Num r, Additive_ vector d r) => r -> vector -> vector -> vector
lerp :: forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
r -> vector -> vector -> vector
lerp r
alpha vector
u vector
v = r
alpha r -> vector -> vector
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
r -> vector -> vector
*^ vector
u vector -> vector -> vector
forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
^+^ (r
1r -> r -> r
forall a. Num a => a -> a -> a
-r
alpha) r -> vector -> vector
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
r -> vector -> vector
*^ vector
v
{-# INLINE lerp #-}

-- | Apply a function to the components of two vectors.
liftI2       :: Additive_ vector d r => (r -> r -> r) -> vector -> vector -> vector
liftI2 :: forall vector (d :: Nat) r.
Additive_ vector d r =>
(r -> r -> r) -> vector -> vector -> vector
liftI2 r -> r -> r
f vector
u vector
v = Identity vector -> vector
forall a. Identity a -> a
runIdentity (Identity vector -> vector) -> Identity vector -> vector
forall a b. (a -> b) -> a -> b
$ (r -> r -> Identity r) -> vector -> vector -> Identity vector
forall vector (d :: Nat) r (f :: * -> *).
(Additive_ vector d r, Apply f) =>
(r -> r -> f r) -> vector -> vector -> f vector
forall (f :: * -> *).
Apply f =>
(r -> r -> f r) -> vector -> vector -> f vector
liftI2A (\r
x r
x' -> r -> Identity r
forall a. a -> Identity a
Identity (r -> Identity r) -> r -> Identity r
forall a b. (a -> b) -> a -> b
$ r -> r -> r
f r
x r
x') vector
u vector
v
{-# INLINE liftI2 #-}

-- | "zip through the two vectors", folding over the result.
--
-- as an example, we can implement the dot product of two vectors u and v using:
--
-- >>> let myDot u v = getSum $ foldMapZip (\x x' -> Sum $ x * x') u v
-- >>> myDot (Vector3 1 2 3) (Vector3 10 20 30)
-- 140
foldMapZip       :: (Additive_ vector d r, Semigroup m)
                 => (r -> r -> m) -> vector -> vector -> m
foldMapZip :: forall vector (d :: Nat) r m.
(Additive_ vector d r, Semigroup m) =>
(r -> r -> m) -> vector -> vector -> m
foldMapZip r -> r -> m
f vector
u vector
v = Const m vector -> m
forall {k} a (b :: k). Const a b -> a
getConst (Const m vector -> m) -> Const m vector -> m
forall a b. (a -> b) -> a -> b
$ (r -> r -> Const m r) -> vector -> vector -> Const m vector
forall vector (d :: Nat) r (f :: * -> *).
(Additive_ vector d r, Apply f) =>
(r -> r -> f r) -> vector -> vector -> f vector
forall (f :: * -> *).
Apply f =>
(r -> r -> f r) -> vector -> vector -> f vector
liftI2A (\r
x r
x' -> m -> Const m r
forall {k} a (b :: k). a -> Const a b
Const (m -> Const m r) -> m -> Const m r
forall a b. (a -> b) -> a -> b
$ r -> r -> m
f r
x r
x') vector
u vector
v
{-# INLINE foldMapZip #-}

-- | unit vector
unit :: forall vector d r. (Additive_ vector d r, Num r) => vector
unit :: forall vector (d :: Nat) r. (Additive_ vector d r, Num r) => vector
unit = ASetter vector vector r r -> (r -> r) -> vector -> vector
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (forall vector vector'.
HasComponents vector vector' =>
IndexedTraversal1
  Int vector vector' (IxValue vector) (IxValue vector')
components @vector @vector) (r -> r -> r
forall a b. a -> b -> a
const r
1) vector
forall r vector (d :: Nat). (Num r, Additive_ vector d r) => vector
zero
{-# INLINE unit #-}

-- | negate v
negated :: (Num r, Vector_ vector d r) => vector -> vector
negated :: forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> vector
negated = ((-r
1) r -> vector -> vector
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
r -> vector -> vector
*^)
{-# INLINABLE negated #-}

-- | left scalar multiplication
(*^)   :: (Num r, Vector_ vector d r) => r -> vector -> vector
r
s *^ :: forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
r -> vector -> vector
*^ vector
v = ASetter vector vector r r -> (r -> r) -> vector -> vector
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter vector vector r r
(IxValue vector -> Identity (IxValue vector))
-> vector -> Identity vector
forall vector vector'.
HasComponents vector vector' =>
IndexedTraversal1
  Int vector vector' (IxValue vector) (IxValue vector')
IndexedTraversal1
  Int vector vector (IxValue vector) (IxValue vector)
components (r
sr -> r -> r
forall a. Num a => a -> a -> a
*) vector
v
{-# INLINABLE (*^) #-}

-- | right scalar multiplication
(^*)   :: (Num r, Vector_ vector d r) => vector -> r -> vector
vector
v ^* :: forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> r -> vector
^* r
s = r
s r -> vector -> vector
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
r -> vector -> vector
*^ vector
v
{-# INLINABLE (^*) #-}

-- | scalar division
(^/)   :: (Vector_ vector d r, Fractional r) => vector -> r -> vector
vector
v ^/ :: forall vector (d :: Nat) r.
(Vector_ vector d r, Fractional r) =>
vector -> r -> vector
^/ r
s = vector
v vector -> r -> vector
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> r -> vector
^* (r
1r -> r -> r
forall a. Fractional a => a -> a -> a
/r
s)
{-# INLINABLE (^/) #-}

-- | sum a collection of vectors.
sumV :: (Foldable f, Additive_ vector d r, Num r) => f vector -> vector
sumV :: forall (f :: * -> *) vector (d :: Nat) r.
(Foldable f, Additive_ vector d r, Num r) =>
f vector -> vector
sumV = (vector -> vector -> vector) -> vector -> f vector -> vector
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' vector -> vector -> vector
forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
(^+^) vector
forall r vector (d :: Nat). (Num r, Additive_ vector d r) => vector
zero
{-# INLINABLE sumV #-}

-- | Produce a default basis for a vector space. If the dimensionality
-- of the vector space is not statically known, see 'basisFor'.
basis :: (Additive_ vector d r, Num r) => [vector]
basis :: forall vector (d :: Nat) r.
(Additive_ vector d r, Num r) =>
[vector]
basis = vector -> [vector]
forall vector (d :: Nat) r.
(Additive_ vector d r, Num r) =>
vector -> [vector]
basisFor vector
forall r vector (d :: Nat). (Num r, Additive_ vector d r) => vector
zero
{-# INLINABLE basis #-}

-- | Produce a default basis for a vector space from which the
-- argument is drawn.
basisFor   :: (Additive_ vector d r, Num r) => vector -> [vector]
basisFor :: forall vector (d :: Nat) r.
(Additive_ vector d r, Num r) =>
vector -> [vector]
basisFor vector
t =
   IndexedGetting Int [vector] vector r
-> (Int -> r -> [vector]) -> vector -> [vector]
forall i m s a. IndexedGetting i m s a -> (i -> a -> m) -> s -> m
ifoldMapOf IndexedGetting Int [vector] vector r
Indexed Int (IxValue vector) (Const [vector] (IxValue vector))
-> vector -> Const [vector] vector
forall vector vector'.
HasComponents vector vector' =>
IndexedTraversal1
  Int vector vector' (IxValue vector) (IxValue vector')
IndexedTraversal1
  Int vector vector (IxValue vector) (IxValue vector)
components ((Int -> r -> [vector]) -> vector -> [vector])
-> vector -> (Int -> r -> [vector]) -> [vector]
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? vector
t ((Int -> r -> [vector]) -> [vector])
-> (Int -> r -> [vector]) -> [vector]
forall a b. (a -> b) -> a -> b
$ \Int
i r
_ ->
     vector -> [vector]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return                  (vector -> [vector]) -> vector -> [vector]
forall a b. (a -> b) -> a -> b
$
       AnIndexedSetter Int vector vector r r
-> (Int -> r -> r) -> vector -> vector
forall i s t a b.
AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t
iover  AnIndexedSetter Int vector vector r r
Indexed Int (IxValue vector) (Identity (IxValue vector))
-> vector -> Identity vector
forall vector vector'.
HasComponents vector vector' =>
IndexedTraversal1
  Int vector vector' (IxValue vector) (IxValue vector')
IndexedTraversal1
  Int vector vector (IxValue vector) (IxValue vector)
components ((Int -> r -> r) -> vector -> vector)
-> vector -> (Int -> r -> r) -> vector
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? vector
t ((Int -> r -> r) -> vector) -> (Int -> r -> r) -> vector
forall a b. (a -> b) -> a -> b
$ \Int
j r
_ ->
         if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j then r
1 else r
0
{-# INLINABLE basisFor #-}


----------------------------------------
-- * Metric

-- | The equivalent class of Linear.Metric
--
-- Note that we do not define a distance itself, and that norm and
-- signorm have a Radical constraint rather than Floating.
class Additive_ vector d r => Metric_ vector d r where
  {-# MINIMAL #-}

  -- | Compute the inner product of two vectors or (equivalently)
  -- convert a vector f a into a covector f a -> a.
  dot    :: Num r => vector -> vector -> r
  dot vector
u vector
v = Getting (Endo (Endo r)) vector r -> vector -> r
forall a s. Num a => Getting (Endo (Endo a)) s a -> s -> a
sumOf Getting (Endo (Endo r)) vector r
(IxValue vector -> Const (Endo (Endo r)) (IxValue vector))
-> vector -> Const (Endo (Endo r)) vector
forall vector vector'.
HasComponents vector vector' =>
IndexedTraversal1
  Int vector vector' (IxValue vector) (IxValue vector')
IndexedTraversal1
  Int vector vector (IxValue vector) (IxValue vector)
components (vector -> r) -> vector -> r
forall a b. (a -> b) -> a -> b
$ (r -> r -> r) -> vector -> vector -> vector
forall vector (d :: Nat) r.
Additive_ vector d r =>
(r -> r -> r) -> vector -> vector -> vector
liftI2 r -> r -> r
forall a. Num a => a -> a -> a
(*) vector
u vector
v
  {-# INLINE dot #-}

  -- | Compute the squared norm. The name quadrance arises from Norman
  -- J. Wildberger's rational trigonometry.
  quadrance   :: Num r => vector -> r
  quadrance vector
v = vector -> vector -> r
forall vector (d :: Nat) r.
(Metric_ vector d r, Num r) =>
vector -> vector -> r
dot vector
v vector
v
  {-# INLINE quadrance #-}

  -- | Compute the quadrance of the difference
  qd     :: Num r => vector -> vector -> r
  qd vector
u vector
v = vector -> r
forall vector (d :: Nat) r.
(Metric_ vector d r, Num r) =>
vector -> r
quadrance (vector -> r) -> vector -> r
forall a b. (a -> b) -> a -> b
$ vector
u vector -> vector -> vector
forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
^-^ vector
v
  {-# INLINE qd #-}

  -- -- | Compute the distance between two vectors in a metric space
  -- distance :: Radical r => vector -> vector -> IxValue vector

  -- | Compute the norm of a vector in a metric space
  norm :: Radical.Radical r => vector -> r
  norm = r -> r
forall r. Radical r => r -> r
Radical.sqrt (r -> r) -> (vector -> r) -> vector -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vector -> r
forall vector (d :: Nat) r.
(Metric_ vector d r, Num r) =>
vector -> r
quadrance
  {-# INLINE norm #-}

  -- | Convert a non-zero vector to unit vector.
  signorm   :: ( Radical.Radical r
               , Fractional r
               ) => vector -> vector
  signorm vector
v = vector
v vector -> r -> vector
forall vector (d :: Nat) r.
(Vector_ vector d r, Fractional r) =>
vector -> r -> vector
^/ vector -> r
forall vector (d :: Nat) r.
(Metric_ vector d r, Radical r) =>
vector -> r
norm vector
v
  {-# INLINE signorm #-}

--------------------------------------------------------------------------------

instance ( Additive_ (Vector d r) d r
         , UniformRange r, Ord (Vector d r)
         ) => UniformRange (Vector d r) where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(Vector d r, Vector d r) -> g -> m (Vector d r)
uniformRM (Vector d r
lows,Vector d r
highs) g
gen = WrappedApplicative m (Vector d r) -> m (Vector d r)
forall (f :: * -> *) a. WrappedApplicative f a -> f a
Apply.unwrapApplicative (WrappedApplicative m (Vector d r) -> m (Vector d r))
-> WrappedApplicative m (Vector d r) -> m (Vector d r)
forall a b. (a -> b) -> a -> b
$
      (r -> r -> WrappedApplicative m r)
-> Vector d r -> Vector d r -> WrappedApplicative m (Vector d r)
forall vector (d :: Nat) r (f :: * -> *).
(Additive_ vector d r, Apply f) =>
(r -> r -> f r) -> vector -> vector -> f vector
forall (f :: * -> *).
Apply f =>
(r -> r -> f r) -> Vector d r -> Vector d r -> f (Vector d r)
liftI2A (\r
l r
h -> m r -> WrappedApplicative m r
forall (f :: * -> *) a. f a -> WrappedApplicative f a
Apply.WrapApplicative (m r -> WrappedApplicative m r) -> m r -> WrappedApplicative m r
forall a b. (a -> b) -> a -> b
$ (r, r) -> g -> m r
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
forall g (m :: * -> *). StatefulGen g m => (r, r) -> g -> m r
uniformRM (r
l,r
h) g
gen) Vector d r
lows Vector d r
highs
  isInRange :: (Vector d r, Vector d r) -> Vector d r -> Bool
isInRange = (Vector d r, Vector d r) -> Vector d r -> Bool
forall a. Ord a => (a, a) -> a -> Bool
isInRangeOrd

instance (Vector_ (Vector d r) d r, Uniform r) => Uniform (Vector d r) where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m (Vector d r)
uniformM g
gen = (Int -> m r) -> m (Vector d r)
forall vector (d :: Nat) r (f :: * -> *).
(Vector_ vector d r, Applicative f) =>
(Int -> f r) -> f vector
forall (f :: * -> *).
Applicative f =>
(Int -> f r) -> f (Vector d r)
generateA (m r -> Int -> m r
forall a b. a -> b -> a
const (m r -> Int -> m r) -> m r -> Int -> m r
forall a b. (a -> b) -> a -> b
$ g -> m r
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
forall g (m :: * -> *). StatefulGen g m => g -> m r
uniformM g
gen)
instance (Additive_ (Vector d r) d r, Uniform r, UniformRange r, Ord (Vector d r)
         ) => Random (Vector d r)

--------------------------------------------------------------------------------
-- * instances for Linear

----------------------------------------

type instance Dimension (Linear.V1 r) = 1

instance AsVector_ (Linear.V1 r)  (Linear.V1 s) 1 r s where
  _Vector :: Iso (V1 r) (V1 s) (Vector 1 r) (Vector 1 s)
_Vector = p (Vector 1 r) (f (Vector 1 s)) -> p (V1 r) (f (V1 s))
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso (V1 r) (V1 s) (Vector 1 r) (Vector 1 s)
coerced
  {-# INLINE _Vector #-}

instance Vector_ (Linear.V1 r) 1 r where
  generateA :: forall (f :: * -> *). Applicative f => (Int -> f r) -> f (V1 r)
generateA Int -> f r
f = r -> V1 r
forall a. a -> V1 a
Linear.V1 (r -> V1 r) -> f r -> f (V1 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f r
f Int
0
  {-# INLINE generateA #-}
  component' :: Int -> IndexedTraversal' Int (V1 r) r
component' Int
i p r (f r)
f v :: V1 r
v@(Linear.V1 r
x) = case Int
i of
                                     Int
0 -> r -> V1 r
forall a. a -> V1 a
Linear.V1 (r -> V1 r) -> f r -> f (V1 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p r (f r) -> Int -> r -> f r
forall a b. p a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p r (f r)
f Int
i r
x
                                     Int
_ -> V1 r -> f (V1 r)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure V1 r
v
  {-# INLINE component' #-}

instance Additive_ (Linear.V1 r) 1 r where
  liftU2 :: (r -> r -> r) -> V1 r -> V1 r -> V1 r
liftU2 r -> r -> r
f (Linear.V1 r
x) (Linear.V1 r
x') = r -> V1 r
forall a. a -> V1 a
Linear.V1 (r -> V1 r) -> r -> V1 r
forall a b. (a -> b) -> a -> b
$ r -> r -> r
f r
x r
x'
  {-# INLINE liftU2 #-}
  liftI2A :: forall (f :: * -> *).
Apply f =>
(r -> r -> f r) -> V1 r -> V1 r -> f (V1 r)
liftI2A r -> r -> f r
f (Linear.V1 r
x) (Linear.V1 r
x') = r -> V1 r
forall a. a -> V1 a
Linear.V1 (r -> V1 r) -> f r -> f (V1 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> r -> f r
f r
x r
x'
  {-# INLINE liftI2A #-}

instance Metric_ (Linear.V1 r) 1 r


----------------------------------------

----------------------------------------

type instance Dimension (Linear.V2 r) = 2

instance AsVector_ (Linear.V2 r)  (Linear.V2 s) 2 r s where
  _Vector :: Iso (V2 r) (V2 s) (Vector 2 r) (Vector 2 s)
_Vector = p (Vector 2 r) (f (Vector 2 s)) -> p (V2 r) (f (V2 s))
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso (V2 r) (V2 s) (Vector 2 r) (Vector 2 s)
coerced
  {-# INLINE _Vector #-}

instance Vector_ (Linear.V2 r) 2 r where
  generateA :: forall (f :: * -> *). Applicative f => (Int -> f r) -> f (V2 r)
generateA Int -> f r
f = r -> r -> V2 r
forall a. a -> a -> V2 a
Linear.V2 (r -> r -> V2 r) -> f r -> f (r -> V2 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f r
f Int
0 f (r -> V2 r) -> f r -> f (V2 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> f r
f Int
1
  {-# INLINE generateA #-}
  component' :: Int -> IndexedTraversal' Int (V2 r) r
component' Int
i p r (f r)
f v :: V2 r
v@(Linear.V2 r
x r
y) = case Int
i of
                                       Int
0 -> (r -> r -> V2 r) -> r -> r -> V2 r
forall a b c. (a -> b -> c) -> b -> a -> c
flip r -> r -> V2 r
forall a. a -> a -> V2 a
Linear.V2 r
y (r -> V2 r) -> f r -> f (V2 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p r (f r) -> Int -> r -> f r
forall a b. p a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p r (f r)
f Int
i r
x
                                       Int
1 -> r -> r -> V2 r
forall a. a -> a -> V2 a
Linear.V2 r
x      (r -> V2 r) -> f r -> f (V2 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p r (f r) -> Int -> r -> f r
forall a b. p a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p r (f r)
f Int
i r
y
                                       Int
_ -> V2 r -> f (V2 r)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure V2 r
v
  {-# INLINE component' #-}

instance Additive_ (Linear.V2 r) 2 r where
  liftU2 :: (r -> r -> r) -> V2 r -> V2 r -> V2 r
liftU2 r -> r -> r
f (Linear.V2 r
x r
y) (Linear.V2 r
x' r
y') = r -> r -> V2 r
forall a. a -> a -> V2 a
Linear.V2 (r -> r -> r
f r
x r
x') (r -> r -> r
f r
y r
y')
  {-# INLINE liftU2 #-}
  liftI2A :: forall (f :: * -> *).
Apply f =>
(r -> r -> f r) -> V2 r -> V2 r -> f (V2 r)
liftI2A r -> r -> f r
f (Linear.V2 r
x r
y) (Linear.V2 r
x' r
y') = r -> r -> V2 r
forall a. a -> a -> V2 a
Linear.V2 (r -> r -> V2 r) -> f r -> f (r -> V2 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> r -> f r
f r
x r
x' f (r -> V2 r) -> f r -> f (V2 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
Apply.<.> r -> r -> f r
f r
y r
y'
  {-# INLINE liftI2A #-}

instance Metric_ (Linear.V2 r) 2 r


--------------------------------------------------------------------------------

type instance Dimension (Linear.V3 r) = 3

instance AsVector_ (Linear.V3 r) (Linear.V3 s) 3 r s where
  _Vector :: Iso (V3 r) (V3 s) (Vector 3 r) (Vector 3 s)
_Vector = p (Vector 3 r) (f (Vector 3 s)) -> p (V3 r) (f (V3 s))
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso (V3 r) (V3 s) (Vector 3 r) (Vector 3 s)
coerced
  {-# INLINE _Vector #-}

instance Vector_ (Linear.V3 r) 3 r where
  generateA :: forall (f :: * -> *). Applicative f => (Int -> f r) -> f (V3 r)
generateA Int -> f r
f = r -> r -> r -> V3 r
forall a. a -> a -> a -> V3 a
Linear.V3 (r -> r -> r -> V3 r) -> f r -> f (r -> r -> V3 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f r
f Int
0 f (r -> r -> V3 r) -> f r -> f (r -> V3 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> f r
f Int
1 f (r -> V3 r) -> f r -> f (V3 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> f r
f Int
2
  {-# INLINE generateA #-}
  component' :: Int -> IndexedTraversal' Int (V3 r) r
component' Int
i p r (f r)
f v :: V3 r
v@(Linear.V3 r
x r
y r
z) = case Int
i of
                                         Int
0 -> (\r
x' -> r -> r -> r -> V3 r
forall a. a -> a -> a -> V3 a
Linear.V3 r
x' r
y r
z) (r -> V3 r) -> f r -> f (V3 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p r (f r) -> Int -> r -> f r
forall a b. p a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p r (f r)
f Int
i r
x
                                         Int
1 -> (\r
y' -> r -> r -> r -> V3 r
forall a. a -> a -> a -> V3 a
Linear.V3 r
x r
y' r
z) (r -> V3 r) -> f r -> f (V3 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p r (f r) -> Int -> r -> f r
forall a b. p a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p r (f r)
f Int
i r
y
                                         Int
2 -> (\r
z' -> r -> r -> r -> V3 r
forall a. a -> a -> a -> V3 a
Linear.V3 r
x r
y r
z') (r -> V3 r) -> f r -> f (V3 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p r (f r) -> Int -> r -> f r
forall a b. p a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p r (f r)
f Int
i r
z
                                         Int
_ -> V3 r -> f (V3 r)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure V3 r
v
  {-# INLINE component' #-}

instance Additive_ (Linear.V3 r) 3 r where
  liftU2 :: (r -> r -> r) -> V3 r -> V3 r -> V3 r
liftU2 r -> r -> r
f (Linear.V3 r
x r
y r
z) (Linear.V3 r
x' r
y' r
z') = r -> r -> r -> V3 r
forall a. a -> a -> a -> V3 a
Linear.V3 (r -> r -> r
f r
x r
x') (r -> r -> r
f r
y r
y') (r -> r -> r
f r
z r
z')
  {-# INLINE liftU2 #-}
  liftI2A :: forall (f :: * -> *).
Apply f =>
(r -> r -> f r) -> V3 r -> V3 r -> f (V3 r)
liftI2A r -> r -> f r
f (Linear.V3 r
x r
y r
z) (Linear.V3 r
x' r
y' r
z') =
    r -> r -> r -> V3 r
forall a. a -> a -> a -> V3 a
Linear.V3 (r -> r -> r -> V3 r) -> f r -> f (r -> r -> V3 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> r -> f r
f r
x r
x' f (r -> r -> V3 r) -> f r -> f (r -> V3 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
Apply.<.> r -> r -> f r
f r
y r
y' f (r -> V3 r) -> f r -> f (V3 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
Apply.<.> r -> r -> f r
f r
z r
z'
  {-# INLINE liftI2A #-}

instance Metric_ (Linear.V3 r) 3 r

--------------------------------------------------------------------------------

type instance Dimension (Linear.V4 r) = 4

instance AsVector_ (Linear.V4 r) (Linear.V4 s) 4 r s where
  _Vector :: Iso (V4 r) (V4 s) (Vector 4 r) (Vector 4 s)
_Vector = p (Vector 4 r) (f (Vector 4 s)) -> p (V4 r) (f (V4 s))
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso (V4 r) (V4 s) (Vector 4 r) (Vector 4 s)
coerced
  {-# INLINE _Vector #-}

instance Vector_ (Linear.V4 r) 4 r where
  generateA :: forall (f :: * -> *). Applicative f => (Int -> f r) -> f (V4 r)
generateA Int -> f r
f = r -> r -> r -> r -> V4 r
forall a. a -> a -> a -> a -> V4 a
Linear.V4 (r -> r -> r -> r -> V4 r) -> f r -> f (r -> r -> r -> V4 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f r
f Int
0 f (r -> r -> r -> V4 r) -> f r -> f (r -> r -> V4 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> f r
f Int
1 f (r -> r -> V4 r) -> f r -> f (r -> V4 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> f r
f Int
2 f (r -> V4 r) -> f r -> f (V4 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> f r
f Int
3
  {-# INLINE generateA #-}
  component' :: Int -> IndexedTraversal' Int (V4 r) r
component' Int
i p r (f r)
f v :: V4 r
v@(Linear.V4 r
x r
y r
z r
w) = case Int
i of
                                           Int
0 -> (\r
x' -> r -> r -> r -> r -> V4 r
forall a. a -> a -> a -> a -> V4 a
Linear.V4 r
x' r
y r
z r
w) (r -> V4 r) -> f r -> f (V4 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p r (f r) -> Int -> r -> f r
forall a b. p a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p r (f r)
f Int
i r
x
                                           Int
1 -> (\r
y' -> r -> r -> r -> r -> V4 r
forall a. a -> a -> a -> a -> V4 a
Linear.V4 r
x r
y' r
z r
w) (r -> V4 r) -> f r -> f (V4 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p r (f r) -> Int -> r -> f r
forall a b. p a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p r (f r)
f Int
i r
y
                                           Int
2 -> (\r
z' -> r -> r -> r -> r -> V4 r
forall a. a -> a -> a -> a -> V4 a
Linear.V4 r
x r
y r
z' r
w) (r -> V4 r) -> f r -> f (V4 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p r (f r) -> Int -> r -> f r
forall a b. p a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p r (f r)
f Int
i r
z
                                           Int
3 -> (\r
w' -> r -> r -> r -> r -> V4 r
forall a. a -> a -> a -> a -> V4 a
Linear.V4 r
x r
y r
z r
w') (r -> V4 r) -> f r -> f (V4 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p r (f r) -> Int -> r -> f r
forall a b. p a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p r (f r)
f Int
i r
w
                                           Int
_ -> V4 r -> f (V4 r)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure V4 r
v
  {-# INLINE component' #-}

instance Additive_ (Linear.V4 r) 4 r where
  liftU2 :: (r -> r -> r) -> V4 r -> V4 r -> V4 r
liftU2 r -> r -> r
f (Linear.V4 r
x r
y r
z r
w) (Linear.V4 r
x' r
y' r
z' r
w') =
    r -> r -> r -> r -> V4 r
forall a. a -> a -> a -> a -> V4 a
Linear.V4 (r -> r -> r
f r
x r
x') (r -> r -> r
f r
y r
y') (r -> r -> r
f r
z r
z') (r -> r -> r
f r
w r
w')
  {-# INLINE liftU2 #-}
  liftI2A :: forall (f :: * -> *).
Apply f =>
(r -> r -> f r) -> V4 r -> V4 r -> f (V4 r)
liftI2A r -> r -> f r
f (Linear.V4 r
x r
y r
z r
w) (Linear.V4 r
x' r
y' r
z' r
w') =
    r -> r -> r -> r -> V4 r
forall a. a -> a -> a -> a -> V4 a
Linear.V4 (r -> r -> r -> r -> V4 r) -> f r -> f (r -> r -> r -> V4 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> r -> f r
f r
x r
x' f (r -> r -> r -> V4 r) -> f r -> f (r -> r -> V4 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
Apply.<.> r -> r -> f r
f r
y r
y' f (r -> r -> V4 r) -> f r -> f (r -> V4 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
Apply.<.> r -> r -> f r
f r
z r
z' f (r -> V4 r) -> f r -> f (V4 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
Apply.<.> r -> r -> f r
f r
w r
w'
  {-# INLINE liftI2A #-}

instance Metric_ (Linear.V4 r) 4 r

--------------------------------------------------------------------------------

instance Vector_ (Vector 1 r) 1 r  where
  generateA :: forall (f :: * -> *).
Applicative f =>
(Int -> f r) -> f (Vector 1 r)
generateA Int -> f r
f = r -> Vector 1 r
forall r. r -> Vector 1 r
Vector1 (r -> Vector 1 r) -> f r -> f (Vector 1 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f r
f Int
0
  {-# INLINE generateA #-}
instance Vector_ (Vector 2 r) 2 r  where
  generateA :: forall (f :: * -> *).
Applicative f =>
(Int -> f r) -> f (Vector 2 r)
generateA Int -> f r
f = r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 (r -> r -> Vector 2 r) -> f r -> f (r -> Vector 2 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f r
f Int
0 f (r -> Vector 2 r) -> f r -> f (Vector 2 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> f r
f Int
1
  {-# INLINE generateA #-}
instance Vector_ (Vector 3 r) 3 r  where
  generateA :: forall (f :: * -> *).
Applicative f =>
(Int -> f r) -> f (Vector 3 r)
generateA Int -> f r
f = r -> r -> r -> Vector 3 r
forall r. r -> r -> r -> Vector 3 r
Vector3 (r -> r -> r -> Vector 3 r) -> f r -> f (r -> r -> Vector 3 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f r
f Int
0 f (r -> r -> Vector 3 r) -> f r -> f (r -> Vector 3 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> f r
f Int
1 f (r -> Vector 3 r) -> f r -> f (Vector 3 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> f r
f Int
2
  {-# INLINE generateA #-}
instance Vector_ (Vector 4 r) 4 r  where
  generateA :: forall (f :: * -> *).
Applicative f =>
(Int -> f r) -> f (Vector 4 r)
generateA Int -> f r
f = r -> r -> r -> r -> Vector 4 r
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 (r -> r -> r -> r -> Vector 4 r)
-> f r -> f (r -> r -> r -> Vector 4 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f r
f Int
0 f (r -> r -> r -> Vector 4 r) -> f r -> f (r -> r -> Vector 4 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> f r
f Int
1 f (r -> r -> Vector 4 r) -> f r -> f (r -> Vector 4 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> f r
f Int
2 f (r -> Vector 4 r) -> f r -> f (Vector 4 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> f r
f Int
3
  {-# INLINE generateA #-}

instance Additive_ (Vector 1 r) 1 r where
  liftU2 :: (r -> r -> r) -> Vector 1 r -> Vector 1 r -> Vector 1 r
liftU2 r -> r -> r
f (Vector1 r
x) (Vector1 r
x') = r -> Vector 1 r
forall r. r -> Vector 1 r
Vector1 (r -> Vector 1 r) -> r -> Vector 1 r
forall a b. (a -> b) -> a -> b
$ r -> r -> r
f r
x r
x'
  {-# INLINE liftU2 #-}
  liftI2A :: forall (f :: * -> *).
Apply f =>
(r -> r -> f r) -> Vector 1 r -> Vector 1 r -> f (Vector 1 r)
liftI2A r -> r -> f r
f (Vector1 r
x) (Vector1 r
x') = r -> Vector 1 r
forall r. r -> Vector 1 r
Vector1 (r -> Vector 1 r) -> f r -> f (Vector 1 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> r -> f r
f r
x r
x'
  {-# INLINE liftI2A #-}

instance Additive_ (Vector 2 r) 2 r where
  liftU2 :: (r -> r -> r) -> Vector 2 r -> Vector 2 r -> Vector 2 r
liftU2 r -> r -> r
f (Vector2 r
x r
y) (Vector2 r
x' r
y') = r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 (r -> r -> r
f r
x r
x') (r -> r -> r
f r
y r
y')
  {-# INLINE liftU2 #-}
  liftI2A :: forall (f :: * -> *).
Apply f =>
(r -> r -> f r) -> Vector 2 r -> Vector 2 r -> f (Vector 2 r)
liftI2A r -> r -> f r
f (Vector2 r
x r
y) (Vector2 r
x' r
y') = r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 (r -> r -> Vector 2 r) -> f r -> f (r -> Vector 2 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> r -> f r
f r
x r
x' f (r -> Vector 2 r) -> f r -> f (Vector 2 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
Apply.<.> r -> r -> f r
f r
y r
y'
  {-# INLINE liftI2A #-}

instance Additive_ (Vector 3 r) 3 r where
  liftU2 :: (r -> r -> r) -> Vector 3 r -> Vector 3 r -> Vector 3 r
liftU2 r -> r -> r
f (Vector3 r
x r
y r
z) (Vector3 r
x' r
y' r
z') = r -> r -> r -> Vector 3 r
forall r. r -> r -> r -> Vector 3 r
Vector3 (r -> r -> r
f r
x r
x') (r -> r -> r
f r
y r
y') (r -> r -> r
f r
z r
z')
  {-# INLINE liftU2 #-}
  liftI2A :: forall (f :: * -> *).
Apply f =>
(r -> r -> f r) -> Vector 3 r -> Vector 3 r -> f (Vector 3 r)
liftI2A r -> r -> f r
f (Vector3 r
x r
y r
z) (Vector3 r
x' r
y' r
z') =
    r -> r -> r -> Vector 3 r
forall r. r -> r -> r -> Vector 3 r
Vector3 (r -> r -> r -> Vector 3 r) -> f r -> f (r -> r -> Vector 3 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> r -> f r
f r
x r
x' f (r -> r -> Vector 3 r) -> f r -> f (r -> Vector 3 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
Apply.<.> r -> r -> f r
f r
y r
y' f (r -> Vector 3 r) -> f r -> f (Vector 3 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
Apply.<.> r -> r -> f r
f r
z r
z'
  {-# INLINE liftI2A #-}

instance Additive_ (Vector 4 r) 4 r where
  liftU2 :: (r -> r -> r) -> Vector 4 r -> Vector 4 r -> Vector 4 r
liftU2 r -> r -> r
f (Vector4 r
x r
y r
z r
w) (Vector4 r
x' r
y' r
z' r
w') =
    r -> r -> r -> r -> Vector 4 r
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 (r -> r -> r
f r
x r
x') (r -> r -> r
f r
y r
y') (r -> r -> r
f r
z r
z') (r -> r -> r
f r
w r
w')
  {-# INLINE liftU2 #-}
  liftI2A :: forall (f :: * -> *).
Apply f =>
(r -> r -> f r) -> Vector 4 r -> Vector 4 r -> f (Vector 4 r)
liftI2A r -> r -> f r
f (Vector4 r
x r
y r
z r
w) (Vector4 r
x' r
y' r
z' r
w') =
    r -> r -> r -> r -> Vector 4 r
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 (r -> r -> r -> r -> Vector 4 r)
-> f r -> f (r -> r -> r -> Vector 4 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> r -> f r
f r
x r
x' f (r -> r -> r -> Vector 4 r) -> f r -> f (r -> r -> Vector 4 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
Apply.<.> r -> r -> f r
f r
y r
y' f (r -> r -> Vector 4 r) -> f r -> f (r -> Vector 4 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
Apply.<.> r -> r -> f r
f r
z r
z' f (r -> Vector 4 r) -> f r -> f (Vector 4 r)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
Apply.<.> r -> r -> f r
f r
w r
w'
  {-# INLINE liftI2A #-}

instance Metric_ (Vector 1 r) 1 r
instance Metric_ (Vector 2 r) 2 r
instance Metric_ (Vector 3 r) 3 r
instance Metric_ (Vector 4 r) 4 r

--------------------------------------------------------------------------------

instance ( Vector_ (Vector d r) d r
         , Read r
         , KnownNat d
         ) => Read (Vector d r) where
  readPrec :: ReadPrec (Vector d r)
readPrec = ReadPrec (Vector d r) -> ReadPrec (Vector d r)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec (Vector d r) -> ReadPrec (Vector d r))
-> ReadPrec (Vector d r) -> ReadPrec (Vector d r)
forall a b. (a -> b) -> a -> b
$
      ReadPrec [r]
-> String -> ([r] -> Vector d r) -> ReadPrec (Vector d r)
forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith (Int -> ReadPrec r -> ReadPrec [r]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
d ReadPrec r
forall a. Read a => ReadPrec a
readPrec) String
constr (([r] -> Vector d r) -> ReadPrec (Vector d r))
-> ([r] -> Vector d r) -> ReadPrec (Vector d r)
forall a b. (a -> b) -> a -> b
$ \[r]
rs ->
        case [r] -> Maybe (Vector d r)
forall vector (d :: Nat) r.
Vector_ vector d r =>
[r] -> Maybe vector
vectorFromList [r]
rs of
          Just Vector d r
p -> Vector d r
p
          Maybe (Vector d r)
_      -> String -> Vector d r
forall a. HasCallStack => String -> a
error String
"internal error in HGeometry.Vector read instance."
    where
      d :: Int
d        = Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal @d Proxy d
forall {k} (t :: k). Proxy t
Proxy)
      constr :: String
constr   = String
"Vector" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
d

--------------------------------------------------------------------------------

-- | Add an element to the front of the vector
--
-- >>> cons 5 myVec2 :: Vector 3 Int
-- Vector3 5 10 20
cons     :: forall vector' vector d r.
            (Vector_ vector d r, Vector_ vector' (d+1) r)
         => r -> vector -> vector'
cons :: forall vector' vector (d :: Nat) r.
(Vector_ vector d r, Vector_ vector' (d + 1) r) =>
r -> vector -> vector'
cons r
x vector
v = (Int -> r) -> vector'
forall vector (d :: Nat) r.
Vector_ vector d r =>
(Int -> r) -> vector
generate ((Int -> r) -> vector') -> (Int -> r) -> vector'
forall a b. (a -> b) -> a -> b
$ \case
                        Int
0 -> r
x
                        Int
i -> vector
vvector -> Getting (Endo r) vector r -> r
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!Int -> IndexedTraversal' Int vector r
forall vector (d :: Nat) r.
Vector_ vector d r =>
Int -> IndexedTraversal' Int vector r
component' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
{-# INLINE cons #-}

-- | Add an element to the back of the vector.
--
-- >>> snoc myVec2 5 :: Vector 3 Int
-- Vector3 10 20 5
snoc     :: forall vector' vector d r.
            ( Vector_ vector d r, Vector_ vector' (d+1) r)
         => vector -> r -> vector'
snoc :: forall vector' vector (d :: Nat) r.
(Vector_ vector d r, Vector_ vector' (d + 1) r) =>
vector -> r -> vector'
snoc vector
v r
x = let d :: Int
d = Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Nat -> Int) -> (Proxy d -> Nat) -> Proxy d -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy d -> Nat
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (Proxy d -> Int) -> Proxy d -> Int
forall a b. (a -> b) -> a -> b
$ forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @d
           in (Int -> r) -> vector'
forall vector (d :: Nat) r.
Vector_ vector d r =>
(Int -> r) -> vector
generate ((Int -> r) -> vector') -> (Int -> r) -> vector'
forall a b. (a -> b) -> a -> b
$ \Int
i -> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
d then r
x else vector
vvector -> Getting (Endo r) vector r -> r
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!Int -> IndexedTraversal' Int vector r
forall vector (d :: Nat) r.
Vector_ vector d r =>
Int -> IndexedTraversal' Int vector r
component' Int
i
{-# INLINE snoc #-}

-- | Extract the first element from the vector
--
-- >>> uncons myVec3 :: (Int, Vector 2 Int)
-- (1,Vector2 2 3)
uncons   :: forall vector' vector d r.
            ( Vector_ vector (d+1) r, Vector_ vector' d r
            , 0 <= (d+1)-1, d <= Dimension vector -- these ones are silly
            ) => vector -> (r, vector')
uncons :: forall vector' vector (d :: Nat) r.
(Vector_ vector (d + 1) r, Vector_ vector' d r, 0 <= ((d + 1) - 1),
 d <= Dimension vector) =>
vector -> (r, vector')
uncons vector
v = ( vector
vvector -> Getting r vector r -> r
forall s a. s -> Getting a s a -> a
^.forall (i :: Nat) vector r (d :: Nat).
(i <= (d - 1), KnownNat i, Vector_ vector d r) =>
IndexedLens' Int vector r
component @0, vector -> vector'
forall (i :: Nat) (d :: Nat) vector vector' r.
(i <= d, Vector_ vector d r, Vector_ vector' i r) =>
vector -> vector'
suffix vector
v)
{-# INLINE uncons #-}

-- | Extract the last element from the vector
--
-- >>> unsnoc myVec3  :: (Vector 2 Int, Int)
-- (Vector2 1 2,3)
unsnoc   :: forall vector' vector d r.
            (Vector_ vector (d+1) r, Vector_ vector' d r
            , d <= d+1-1, d <= Dimension vector -- these are silly
            ) => vector -> (vector',r)
unsnoc :: forall vector' vector (d :: Nat) r.
(Vector_ vector (d + 1) r, Vector_ vector' d r, d <= ((d + 1) - 1),
 d <= Dimension vector) =>
vector -> (vector', r)
unsnoc vector
v = ( vector -> vector'
forall (i :: Nat) (d :: Nat) vector vector' r.
(i <= d, Vector_ vector d r, Vector_ vector' i r) =>
vector -> vector'
prefix vector
v, vector
vvector -> Getting r vector r -> r
forall s a. s -> Getting a s a -> a
^.forall (i :: Nat) vector r (d :: Nat).
(i <= (d - 1), KnownNat i, Vector_ vector d r) =>
IndexedLens' Int vector r
component @d )
{-# INLINE unsnoc #-}

{-
-- | Type family that expresses that we can construct a d-dimensional
-- vector from an arity d function.
type ConstructVector :: Type -> Nat -> Type
type family ConstructVector vector d where
  ConstructVector vector 0 = vector
  ConstructVector vector d = IxValue vector -> ConstructVector vector (d-1)


  {-# MINIMAL vectorFromList #-}

-- | Vectors that we can construct using an arity d function
class Vector_ vector d r => ConstructableVector_ vector d r where
  -- | Construct a vector from a d-arity function.
  --
  mkVector :: ConstructVector vector d


--------------------------------------------------------------------------------
-- instances for Linear

type instance Dimension (LinearV1.V1 r) = 1
instance Vector_ (LinearV1.V1 r) 1 r where
  componentProxy i = indexing $ case (fromIntegral . natVal $ i) of
                       0  -> _1
                       i' -> error $ "componentProxy: " <> show i' <> " out of bounds"
  {-# INLINE componentProxy #-}
  vectorFromList = \case
    [x] -> Just $ LinearV1.V1 x
    _   -> Nothing
  {-# INLINE vectorFromList #-}

instance ConstructableVector_ (LinearV1.V1 r) 1 r where
  mkVector = LinearV1.V1

type instance Dimension (LinearV2.V2 r) = 2
instance Vector_ (LinearV2.V2 r) 2 r where
  componentProxy i = indexing $ case (fromIntegral . natVal $ i) of
                       0  -> _1
                       1  -> _2
                       i' -> error $ "componentProxy: " <> show i' <> " out of bounds"
  {-# INLINE componentProxy #-}
  vectorFromList = \case
    [x,y] -> Just $ LinearV2.V2 x y
    _     -> Nothing
  {-# INLINE vectorFromList #-}

instance ConstructableVector_ (LinearV2.V2 r) 2 r where
  mkVector = LinearV2.V2

type instance Dimension (LinearV3.V3 r) = 3
instance Vector_ (LinearV3.V3 r) 3 r where
  componentProxy i = indexing $ case (fromIntegral . natVal $ i) of
                       0  -> _1
                       1  -> _2
                       2  -> _3
                       i' -> error $ "componentProxy: " <> show i' <> " out of bounds"
  {-# INLINE componentProxy #-}
  vectorFromList = \case
    [x,y,z] -> Just $ LinearV3.V3 x y z
    _       -> Nothing
  {-# INLINE vectorFromList #-}

instance ConstructableVector_ (LinearV3.V3 r) 3 r where
  mkVector = LinearV3.V3

type instance Dimension (LinearV4.V4 r) = 4
instance Vector_ (LinearV4.V4 r) 4 r where
  componentProxy i = indexing $ case (fromIntegral . natVal $ i) of
                       0  -> _1
                       1  -> _2
                       2  -> _3
                       3  -> _4
                       i' -> error $ "componentProxy: " <> show i' <> " out of bounds"
  {-# INLINE componentProxy #-}
  vectorFromList = \case
    [x,y,z,w] -> Just $ LinearV4.V4 x y z w
    _         -> Nothing
  {-# INLINE vectorFromList #-}

instance ConstructableVector_ (LinearV4.V4 r) 4 r where
  mkVector = LinearV4.V4

-}

--------------------------------------------------------------------------------

-- -- | A bidirectional pattern synonym for 1 dimensional vectors.
-- pattern Vector1_   :: Vector_ vector 1 r => r -> vector
-- pattern Vector1_ x <- (view (component @0) -> x)
--   where
--     Vector1_ x = generate (const x)
-- {-# COMPLETE Vector1_ #-}
-- {-# INLINE Vector1_ #-}

-- -- | A bidirectional pattern synonym for 2 dimensional vectors.
-- pattern Vector2_     :: Vector_ vector 2 r => r -> r -> vector
-- pattern Vector2_ x y <- (view (component @0) &&& view (component @1) -> (x,y))
--   where
--     Vector2_ x y = uncheckedVectorFromList [x,y]
-- {-# COMPLETE Vector2_ #-}
-- {-# INLINE Vector2_ #-}


-- -- | A bidirectional pattern synonym for 3 dimensional vectors.
-- pattern Vector3_       :: Vector_ vector 3 r => r -> r -> r -> vector
-- pattern Vector3_ x y z <- (view (component @0) &&& view (component @1) &&& view (component @2)
--                           -> (x,(y,z)))
--   where
--     Vector3_ x y z = uncheckedVectorFromList [x,y,z]
-- {-# COMPLETE Vector3_ #-}

-- -- | A bidirectional pattern synonym for 4 dimensional vectors.
-- pattern Vector4_         :: Vector_ vector 4 r => r -> r -> r -> r -> vector
-- pattern Vector4_ x y z w <- (    view (component @0) &&& view (component @1)
--                              &&& view (component @2) &&& view (component @3)
--                             -> (x,(y,(z,w))))
--   where
--     Vector4_ x y z w = uncheckedVectorFromList [x,y,z,w]
-- {-# COMPLETE Vector4_ #-}