Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- module Graphics.GPipe.Internal.Linear
- ($*) :: Representable f => Covector r (Rep f) -> f r -> r
- newtype Covector r a = Covector {
- runCovector :: (a -> r) -> r
- counitalRep :: (Representable f, Coalgebra r (Rep f)) => f r -> r
- comultRep :: (Representable f, Coalgebra r (Rep f)) => f r -> f (f r)
- unitalRep :: (Representable f, Algebra r (Rep f)) => r -> f r
- multRep :: (Representable f, Algebra r (Rep f)) => f (f r) -> f r
- class Num r => Algebra r m where
- class Num r => Coalgebra r m where
- inverseOrtho :: Fractional a => a -> a -> a -> a -> a -> a -> M44 a
- ortho :: Fractional a => a -> a -> a -> a -> a -> a -> M44 a
- inverseInfinitePerspective :: Floating a => a -> a -> a -> M44 a
- infinitePerspective :: Floating a => a -> a -> a -> M44 a
- inverseFrustum :: Floating a => a -> a -> a -> a -> a -> a -> M44 a
- frustum :: Floating a => a -> a -> a -> a -> a -> a -> M44 a
- inversePerspective :: Floating a => a -> a -> a -> a -> M44 a
- perspective :: Floating a => a -> a -> a -> a -> M44 a
- luDetFinite :: forall a m (n :: Nat). (Num a, Fractional a, Functor m, Finite m, n ~ Size m, KnownNat n, Num (m a)) => m (m a) -> a
- luDet :: (Num a, Fractional a, Foldable m, Traversable m, Applicative m, Additive m, Trace m, Ixed (m a), Ixed (m (m a)), i ~ Index (m a), i ~ Index (m (m a)), Eq i, Integral i, a ~ IxValue (m a), m a ~ IxValue (m (m a)), Num (m a)) => m (m a) -> a
- luInvFinite :: forall a m (n :: Nat). (Num a, Fractional a, Functor m, Finite m, n ~ Size m, KnownNat n, Num (m a)) => m (m a) -> m (m a)
- luInv :: (Num a, Fractional a, Foldable m, Traversable m, Applicative m, Additive m, Distributive m, Ixed (m a), Ixed (m (m a)), i ~ Index (m a), i ~ Index (m (m a)), Eq i, Integral i, a ~ IxValue (m a), m a ~ IxValue (m (m a)), Num (m a)) => m (m a) -> m (m a)
- luSolveFinite :: forall a m (n :: Nat). (Num a, Fractional a, Functor m, Finite m, n ~ Size m, KnownNat n, Num (m a)) => m (m a) -> m a -> m a
- luSolve :: (Num a, Fractional a, Foldable m, Traversable m, Applicative m, Additive m, Ixed (m a), Ixed (m (m a)), i ~ Index (m a), i ~ Index (m (m a)), Eq i, Integral i, a ~ IxValue (m a), m a ~ IxValue (m (m a)), Num (m a)) => m (m a) -> m a -> m a
- backwardSubFinite :: forall a m (n :: Nat). (Num a, Fractional a, Foldable m, n ~ Size m, KnownNat n, Additive m, Finite m) => m (m a) -> m a -> m a
- backwardSub :: (Num a, Fractional a, Foldable m, Additive m, Ixed (m a), Ixed (m (m a)), i ~ Index (m a), i ~ Index (m (m a)), Eq i, Ord i, Integral i, a ~ IxValue (m a), m a ~ IxValue (m (m a))) => m (m a) -> m a -> m a
- forwardSubFinite :: forall a m (n :: Nat). (Num a, Fractional a, Foldable m, n ~ Size m, KnownNat n, Additive m, Finite m) => m (m a) -> m a -> m a
- forwardSub :: (Num a, Fractional a, Foldable m, Additive m, Ixed (m a), Ixed (m (m a)), i ~ Index (m a), i ~ Index (m (m a)), Eq i, Ord i, Integral i, a ~ IxValue (m a), m a ~ IxValue (m (m a))) => m (m a) -> m a -> m a
- luFinite :: forall a m (n :: Nat). (Num a, Fractional a, Functor m, Finite m, n ~ Size m, KnownNat n, Num (m a)) => m (m a) -> (m (m a), m (m a))
- lu :: (Num a, Fractional a, Foldable m, Traversable m, Applicative m, Additive m, Ixed (m a), Ixed (m (m a)), i ~ Index (m a), i ~ Index (m (m a)), Eq i, Integral i, a ~ IxValue (m a), m a ~ IxValue (m (m a)), Num (m a)) => m (m a) -> (m (m a), m (m a))
- inv44 :: Fractional a => M44 a -> M44 a
- transpose :: (Distributive g, Functor f) => f (g a) -> g (f a)
- inv33 :: Fractional a => M33 a -> M33 a
- inv22 :: Fractional a => M22 a -> M22 a
- det44 :: Num a => M44 a -> a
- det33 :: Num a => M33 a -> a
- det22 :: Num a => M22 a -> a
- _m44 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R4 t, R4 v) => Lens' (t (v a)) (M44 a)
- _m43 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R4 t, R3 v) => Lens' (t (v a)) (M43 a)
- _m42 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R4 t, R2 v) => Lens' (t (v a)) (M42 a)
- _m34 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R3 t, R4 v) => Lens' (t (v a)) (M34 a)
- _m33 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R3 t, R3 v) => Lens' (t (v a)) (M33 a)
- _m32 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R3 t, R2 v) => Lens' (t (v a)) (M32 a)
- _m24 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R2 t, R4 v) => Lens' (t (v a)) (M24 a)
- _m23 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R2 t, R3 v) => Lens' (t (v a)) (M23 a)
- _m22 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R2 t, R2 v) => Lens' (t (v a)) (M22 a)
- translation :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R3 t, R4 v) => Lens' (t (v a)) (V3 a)
- identity :: (Num a, Traversable t, Applicative t) => t (t a)
- m33_to_m44 :: Num a => M33 a -> M44 a
- m43_to_m44 :: Num a => M43 a -> M44 a
- mkTransformation :: Num a => Quaternion a -> V3 a -> M44 a
- mkTransformationMat :: Num a => M33 a -> V3 a -> M44 a
- fromQuaternion :: Num a => Quaternion a -> M33 a
- adjoint :: (Functor m, Distributive n, Conjugate a) => m (n a) -> n (m a)
- (!!/) :: (Functor m, Functor r, Fractional a) => m (r a) -> a -> m (r a)
- (!!*) :: (Functor m, Functor r, Num a) => m (r a) -> a -> m (r a)
- (*!!) :: (Functor m, Functor r, Num a) => a -> m (r a) -> m (r a)
- (*!) :: (Num a, Foldable t, Additive f, Additive t) => t a -> t (f a) -> f a
- (!*) :: (Functor m, Foldable r, Additive r, Num a) => m (r a) -> r a -> m a
- (!-!) :: (Additive m, Additive n, Num a) => m (n a) -> m (n a) -> m (n a)
- (!+!) :: (Additive m, Additive n, Num a) => m (n a) -> m (n a) -> m (n a)
- (!*!) :: (Functor m, Foldable t, Additive t, Additive n, Num a) => m (t a) -> t (n a) -> m (n a)
- column :: forall (f :: Type -> Type) a b s t. Representable f => LensLike (Context a b) s t a b -> Lens (f s) (f t) (f a) (f b)
- type M22 a = V2 (V2 a)
- type M23 a = V2 (V3 a)
- type M24 a = V2 (V4 a)
- type M32 a = V3 (V2 a)
- type M33 a = V3 (V3 a)
- type M34 a = V3 (V4 a)
- type M42 a = V4 (V2 a)
- type M43 a = V4 (V3 a)
- type M44 a = V4 (V4 a)
- frobenius :: (Num a, Foldable f, Additive f, Additive g, Distributive g, Trace g) => f (g a) -> a
- class Functor m => Trace (m :: Type -> Type) where
- axisAngle :: (Epsilon a, Floating a) => V3 a -> a -> Quaternion a
- rotate :: (Conjugate a, RealFloat a) => Quaternion a -> V3 a -> V3 a
- slerp :: RealFloat a => Quaternion a -> Quaternion a -> a -> Quaternion a
- atanhq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a
- acoshq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a
- asinhq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a
- atanq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a
- acosq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a
- asinq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a
- pow :: RealFloat a => Quaternion a -> a -> Quaternion a
- absi :: Floating a => Quaternion a -> a
- ek :: forall (t :: Type -> Type). Hamiltonian t => E t
- ej :: forall (t :: Type -> Type). Hamiltonian t => E t
- ei :: forall (t :: Type -> Type). Complicated t => E t
- ee :: forall (t :: Type -> Type). Complicated t => E t
- data Quaternion a = Quaternion !a !(V3 a)
- class Complicated (t :: Type -> Type) where
- class Complicated t => Hamiltonian (t :: Type -> Type) where
- data V0 a = V0
- normalizePoint :: Fractional a => V4 a -> V3 a
- point :: Num a => V3 a -> V4 a
- vector :: Num a => V3 a -> V4 a
- ew :: forall (t :: Type -> Type). R4 t => E t
- _wzyx :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _wzxy :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _wyzx :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _wyxz :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _wxzy :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _wxyz :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _zwyx :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _zwxy :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _zywx :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _zyxw :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _zxwy :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _zxyw :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _ywzx :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _ywxz :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _yzwx :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _yzxw :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _yxwz :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _yxzw :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _xwzy :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _xwyz :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _xzwy :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _xzyw :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _xywz :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V4 a)
- _wzy :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _wzx :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _wyz :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _wyx :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _wxz :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _wxy :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _zwy :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _zwx :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _zyw :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _zxw :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _ywz :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _ywx :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _yzw :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _yxw :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _xwz :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _xwy :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _xzw :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _xyw :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V3 a)
- _wz :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V2 a)
- _wy :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V2 a)
- _wx :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V2 a)
- _zw :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V2 a)
- _yw :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V2 a)
- _xw :: forall (t :: Type -> Type) a. R4 t => Lens' (t a) (V2 a)
- data V4 a = V4 !a !a !a !a
- class R3 t => R4 (t :: Type -> Type) where
- triple :: Num a => V3 a -> V3 a -> V3 a -> a
- cross :: Num a => V3 a -> V3 a -> V3 a
- ez :: forall (t :: Type -> Type). R3 t => E t
- _zyx :: forall (t :: Type -> Type) a. R3 t => Lens' (t a) (V3 a)
- _zxy :: forall (t :: Type -> Type) a. R3 t => Lens' (t a) (V3 a)
- _yzx :: forall (t :: Type -> Type) a. R3 t => Lens' (t a) (V3 a)
- _yxz :: forall (t :: Type -> Type) a. R3 t => Lens' (t a) (V3 a)
- _xzy :: forall (t :: Type -> Type) a. R3 t => Lens' (t a) (V3 a)
- _zy :: forall (t :: Type -> Type) a. R3 t => Lens' (t a) (V2 a)
- _zx :: forall (t :: Type -> Type) a. R3 t => Lens' (t a) (V2 a)
- _yz :: forall (t :: Type -> Type) a. R3 t => Lens' (t a) (V2 a)
- _xz :: forall (t :: Type -> Type) a. R3 t => Lens' (t a) (V2 a)
- data V3 a = V3 !a !a !a
- class R2 t => R3 (t :: Type -> Type) where
- crossZ :: Num a => V2 a -> V2 a -> a
- unangle :: (Floating a, Ord a) => V2 a -> a
- angle :: Floating a => a -> V2 a
- perp :: Num a => V2 a -> V2 a
- ey :: forall (t :: Type -> Type). R2 t => E t
- _yx :: forall (t :: Type -> Type) a. R2 t => Lens' (t a) (V2 a)
- data V2 a = V2 !a !a
- class R1 t => R2 (t :: Type -> Type) where
- ex :: forall (t :: Type -> Type). R1 t => E t
- newtype V1 a = V1 a
- class R1 (t :: Type -> Type) where
- project :: (Metric v, Fractional a) => v a -> v a -> v a
- normalize :: (Floating a, Metric f, Epsilon a) => f a -> f a
- class Additive f => Metric (f :: Type -> Type) where
- outer :: (Functor f, Functor g, Num a) => f a -> g a -> f (g a)
- unit :: (Additive t, Num a) => ASetter' (t a) a -> t a
- scaled :: (Traversable t, Num a) => t a -> t (t a)
- basisFor :: (Traversable t, Num a) => t b -> [t a]
- basis :: (Additive t, Traversable t, Num a) => [t a]
- (^/) :: (Functor f, Fractional a) => f a -> a -> f a
- (^*) :: (Functor f, Num a) => f a -> a -> f a
- (*^) :: (Functor f, Num a) => a -> f a -> f a
- sumV :: (Foldable f, Additive v, Num a) => f (v a) -> v a
- negated :: (Functor f, Num a) => f a -> f a
- newtype E (t :: Type -> Type) = E {}
- class Functor f => Additive (f :: Type -> Type) where
- class Num a => Epsilon a where
- class Num a => Conjugate a where
- conjugate :: a -> a
- class Conjugate a => TrivialConjugate a
- getLinear :: (Binary a, Applicative t, Traversable t) => Get (t a)
- putLinear :: (Binary a, Foldable t) => t a -> Put
Documentation
($*) :: Representable f => Covector r (Rep f) -> f r -> r infixr 0 #
Linear functionals from elements of an (infinite) free module to a scalar
Covector | |
|
Instances
Monad (Covector r) | |
Functor (Covector r) | |
Applicative (Covector r) | |
Num r => Alternative (Covector r) | |
Num r => MonadPlus (Covector r) | |
Apply (Covector r) | |
Num r => Plus (Covector r) | |
Defined in Linear.Covector | |
Num r => Alt (Covector r) | |
Bind (Covector r) | |
Coalgebra r m => Num (Covector r m) | |
Defined in Linear.Covector (+) :: Covector r m -> Covector r m -> Covector r m # (-) :: Covector r m -> Covector r m -> Covector r m # (*) :: Covector r m -> Covector r m -> Covector r m # negate :: Covector r m -> Covector r m # abs :: Covector r m -> Covector r m # signum :: Covector r m -> Covector r m # fromInteger :: Integer -> Covector r m # |
counitalRep :: (Representable f, Coalgebra r (Rep f)) => f r -> r #
comultRep :: (Representable f, Coalgebra r (Rep f)) => f r -> f (f r) #
unitalRep :: (Representable f, Algebra r (Rep f)) => r -> f r #
multRep :: (Representable f, Algebra r (Rep f)) => f (f r) -> f r #
class Num r => Algebra r m where #
An associative unital algebra over a ring
Instances
Num r => Algebra r Void | |
Num r => Algebra r () | |
Defined in Linear.Algebra | |
Num r => Algebra r (E V0) | |
Num r => Algebra r (E V1) | |
Num r => Algebra r (E Complex) | |
(Num r, TrivialConjugate r) => Algebra r (E Quaternion) | |
Defined in Linear.Algebra mult :: (E Quaternion -> E Quaternion -> r) -> E Quaternion -> r # unital :: r -> E Quaternion -> r # | |
(Algebra r a, Algebra r b) => Algebra r (a, b) | |
Defined in Linear.Algebra |
class Num r => Coalgebra r m where #
A coassociative counital coalgebra over a ring
Instances
Num r => Coalgebra r Void | |
Num r => Coalgebra r () | |
Defined in Linear.Algebra | |
Num r => Coalgebra r (E V0) | |
Num r => Coalgebra r (E V1) | |
Num r => Coalgebra r (E V2) | |
Num r => Coalgebra r (E V3) | |
Num r => Coalgebra r (E V4) | |
Num r => Coalgebra r (E Complex) | |
(Num r, TrivialConjugate r) => Coalgebra r (E Quaternion) | |
Defined in Linear.Algebra comult :: (E Quaternion -> r) -> E Quaternion -> E Quaternion -> r # counital :: (E Quaternion -> r) -> r # | |
(Coalgebra r m, Coalgebra r n) => Coalgebra r (m, n) | |
Defined in Linear.Algebra |
:: Fractional a | |
=> a | Left |
-> a | Right |
-> a | Bottom |
-> a | Top |
-> a | Near |
-> a | Far |
-> M44 a |
Build an inverse orthographic perspective matrix from 6 clipping planes
:: Fractional a | |
=> a | Left |
-> a | Right |
-> a | Bottom |
-> a | Top |
-> a | Near |
-> a | Far |
-> M44 a |
Build an orthographic perspective matrix from 6 clipping planes. This matrix takes the region delimited by these planes and maps it to normalized device coordinates between [-1,1]
This call is designed to mimic the parameters to the OpenGL glOrtho
call, so it has a slightly strange convention: Notably: the near and
far planes are negated.
Consequently:
ortho
l r b t n f !*V4
l b (-n) 1 =V4
(-1) (-1) (-1) 1ortho
l r b t n f !*V4
r t (-f) 1 =V4
1 1 1 1
Examples:
>>>
ortho 1 2 3 4 5 6 !* V4 1 3 (-5) 1
V4 (-1.0) (-1.0) (-1.0) 1.0
>>>
ortho 1 2 3 4 5 6 !* V4 2 4 (-6) 1
V4 1.0 1.0 1.0 1.0
Build a matrix for a symmetric perspective-view frustum with a far plane at infinite
Build a perspective matrix per the classic glFrustum
arguments.
Build an inverse perspective matrix
Build a matrix for a symmetric perspective-view frustum
luDetFinite :: forall a m (n :: Nat). (Num a, Fractional a, Functor m, Finite m, n ~ Size m, KnownNat n, Num (m a)) => m (m a) -> a #
Compute the determinant of a matrix using LU decomposition, using the
vector's Finite
instance to provide an index.
luDet :: (Num a, Fractional a, Foldable m, Traversable m, Applicative m, Additive m, Trace m, Ixed (m a), Ixed (m (m a)), i ~ Index (m a), i ~ Index (m (m a)), Eq i, Integral i, a ~ IxValue (m a), m a ~ IxValue (m (m a)), Num (m a)) => m (m a) -> a #
Compute the determinant of a matrix using LU decomposition.
luInvFinite :: forall a m (n :: Nat). (Num a, Fractional a, Functor m, Finite m, n ~ Size m, KnownNat n, Num (m a)) => m (m a) -> m (m a) #
Invert a matrix with LU decomposition, using the vector's Finite
instance
to provide an index.
luInv :: (Num a, Fractional a, Foldable m, Traversable m, Applicative m, Additive m, Distributive m, Ixed (m a), Ixed (m (m a)), i ~ Index (m a), i ~ Index (m (m a)), Eq i, Integral i, a ~ IxValue (m a), m a ~ IxValue (m (m a)), Num (m a)) => m (m a) -> m (m a) #
Invert a matrix with LU decomposition.
luSolveFinite :: forall a m (n :: Nat). (Num a, Fractional a, Functor m, Finite m, n ~ Size m, KnownNat n, Num (m a)) => m (m a) -> m a -> m a #
Solve a linear system with LU decomposition, using the vector's Finite
instance to provide an index.
luSolve :: (Num a, Fractional a, Foldable m, Traversable m, Applicative m, Additive m, Ixed (m a), Ixed (m (m a)), i ~ Index (m a), i ~ Index (m (m a)), Eq i, Integral i, a ~ IxValue (m a), m a ~ IxValue (m (m a)), Num (m a)) => m (m a) -> m a -> m a #
Solve a linear system with LU decomposition.
backwardSubFinite :: forall a m (n :: Nat). (Num a, Fractional a, Foldable m, n ~ Size m, KnownNat n, Additive m, Finite m) => m (m a) -> m a -> m a #
Solve a linear system with an upper-triangular matrix of coefficients with
backwards substitution, using the vector's Finite
instance to provide an
index.
backwardSub :: (Num a, Fractional a, Foldable m, Additive m, Ixed (m a), Ixed (m (m a)), i ~ Index (m a), i ~ Index (m (m a)), Eq i, Ord i, Integral i, a ~ IxValue (m a), m a ~ IxValue (m (m a))) => m (m a) -> m a -> m a #
Solve a linear system with an upper-triangular matrix of coefficients with backwards substitution.
forwardSubFinite :: forall a m (n :: Nat). (Num a, Fractional a, Foldable m, n ~ Size m, KnownNat n, Additive m, Finite m) => m (m a) -> m a -> m a #
Solve a linear system with a lower-triangular matrix of coefficients with
forwards substitution, using the vector's Finite
instance to provide an
index.
forwardSub :: (Num a, Fractional a, Foldable m, Additive m, Ixed (m a), Ixed (m (m a)), i ~ Index (m a), i ~ Index (m (m a)), Eq i, Ord i, Integral i, a ~ IxValue (m a), m a ~ IxValue (m (m a))) => m (m a) -> m a -> m a #
Solve a linear system with a lower-triangular matrix of coefficients with forwards substitution.
luFinite :: forall a m (n :: Nat). (Num a, Fractional a, Functor m, Finite m, n ~ Size m, KnownNat n, Num (m a)) => m (m a) -> (m (m a), m (m a)) #
Compute the (L, U) decomposition of a square matrix using Crout's
algorithm, using the vector's Finite
instance to provide an index.
lu :: (Num a, Fractional a, Foldable m, Traversable m, Applicative m, Additive m, Ixed (m a), Ixed (m (m a)), i ~ Index (m a), i ~ Index (m (m a)), Eq i, Integral i, a ~ IxValue (m a), m a ~ IxValue (m (m a)), Num (m a)) => m (m a) -> (m (m a), m (m a)) #
inv44 :: Fractional a => M44 a -> M44 a #
4x4 matrix inverse.
transpose :: (Distributive g, Functor f) => f (g a) -> g (f a) #
transpose
is just an alias for distribute
transpose (V3 (V2 1 2) (V2 3 4) (V2 5 6))
V2 (V3 1 3 5) (V3 2 4 6)
inv33 :: Fractional a => M33 a -> M33 a #
3x3 matrix inverse.
>>>
inv33 $ V3 (V3 1 2 4) (V3 4 2 2) (V3 1 1 1)
V3 (V3 0.0 0.5 (-1.0)) (V3 (-0.5) (-0.75) 3.5) (V3 0.5 0.25 (-1.5))
inv22 :: Fractional a => M22 a -> M22 a #
2x2 matrix inverse.
>>>
inv22 $ V2 (V2 1 2) (V2 3 4)
V2 (V2 (-2.0) 1.0) (V2 1.5 (-0.5))
det33 :: Num a => M33 a -> a #
3x3 matrix determinant.
>>>
det33 (V3 (V3 a b c) (V3 d e f) (V3 g h i))
a * (e * i - f * h) - d * (b * i - c * h) + g * (b * f - c * e)
_m44 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R4 t, R4 v) => Lens' (t (v a)) (M44 a) #
Extract a 4x4 matrix from a matrix of higher dimensions by dropping excess rows and columns.
_m43 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R4 t, R3 v) => Lens' (t (v a)) (M43 a) #
Extract a 4x3 matrix from a matrix of higher dimensions by dropping excess rows and columns.
_m42 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R4 t, R2 v) => Lens' (t (v a)) (M42 a) #
Extract a 4x2 matrix from a matrix of higher dimensions by dropping excess rows and columns.
_m34 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R3 t, R4 v) => Lens' (t (v a)) (M34 a) #
Extract a 3x4 matrix from a matrix of higher dimensions by dropping excess rows and columns.
_m33 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R3 t, R3 v) => Lens' (t (v a)) (M33 a) #
Extract a 3x3 matrix from a matrix of higher dimensions by dropping excess rows and columns.
_m32 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R3 t, R2 v) => Lens' (t (v a)) (M32 a) #
Extract a 3x2 matrix from a matrix of higher dimensions by dropping excess rows and columns.
_m24 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R2 t, R4 v) => Lens' (t (v a)) (M24 a) #
Extract a 2x4 matrix from a matrix of higher dimensions by dropping excess rows and columns.
_m23 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R2 t, R3 v) => Lens' (t (v a)) (M23 a) #
Extract a 2x3 matrix from a matrix of higher dimensions by dropping excess rows and columns.
_m22 :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R2 t, R2 v) => Lens' (t (v a)) (M22 a) #
Extract a 2x2 matrix from a matrix of higher dimensions by dropping excess rows and columns.
translation :: forall (t :: Type -> Type) (v :: Type -> Type) a. (Representable t, R3 t, R4 v) => Lens' (t (v a)) (V3 a) #
Extract the translation vector (first three entries of the last column) from a 3x4 or 4x4 matrix.
identity :: (Num a, Traversable t, Applicative t) => t (t a) #
The identity matrix for any dimension vector.
>>>
identity :: M44 Int
V4 (V4 1 0 0 0) (V4 0 1 0 0) (V4 0 0 1 0) (V4 0 0 0 1)>>>
identity :: V3 (V3 Int)
V3 (V3 1 0 0) (V3 0 1 0) (V3 0 0 1)
m33_to_m44 :: Num a => M33 a -> M44 a #
Convert a 3x3 matrix to a 4x4 matrix extending it with 0's in the new row and column.
m43_to_m44 :: Num a => M43 a -> M44 a #
Convert from a 4x3 matrix to a 4x4 matrix, extending it with the [ 0 0 0 1 ]
column vector
mkTransformation :: Num a => Quaternion a -> V3 a -> M44 a #
Build a transformation matrix from a rotation expressed as a
Quaternion
and a translation vector.
mkTransformationMat :: Num a => M33 a -> V3 a -> M44 a #
Build a transformation matrix from a rotation matrix and a translation vector.
fromQuaternion :: Num a => Quaternion a -> M33 a #
Build a rotation matrix from a unit Quaternion
.
adjoint :: (Functor m, Distributive n, Conjugate a) => m (n a) -> n (m a) #
Hermitian conjugate or conjugate transpose
>>>
adjoint (V2 (V2 (1 :+ 2) (3 :+ 4)) (V2 (5 :+ 6) (7 :+ 8)))
V2 (V2 (1.0 :+ (-2.0)) (5.0 :+ (-6.0))) (V2 (3.0 :+ (-4.0)) (7.0 :+ (-8.0)))
(!!/) :: (Functor m, Functor r, Fractional a) => m (r a) -> a -> m (r a) infixl 7 #
Matrix-scalar division
(!!*) :: (Functor m, Functor r, Num a) => m (r a) -> a -> m (r a) infixl 7 #
Matrix-scalar product
>>>
V2 (V2 1 2) (V2 3 4) !!* 5
V2 (V2 5 10) (V2 15 20)
(*!!) :: (Functor m, Functor r, Num a) => a -> m (r a) -> m (r a) infixl 7 #
Scalar-matrix product
>>>
5 *!! V2 (V2 1 2) (V2 3 4)
V2 (V2 5 10) (V2 15 20)
(*!) :: (Num a, Foldable t, Additive f, Additive t) => t a -> t (f a) -> f a infixl 7 #
Row vector * matrix
>>>
V2 1 2 *! V2 (V3 3 4 5) (V3 6 7 8)
V3 15 18 21
(!*) :: (Functor m, Foldable r, Additive r, Num a) => m (r a) -> r a -> m a infixl 7 #
Matrix * column vector
>>>
V2 (V3 1 2 3) (V3 4 5 6) !* V3 7 8 9
V2 50 122
(!-!) :: (Additive m, Additive n, Num a) => m (n a) -> m (n a) -> m (n a) infixl 6 #
Entry-wise matrix subtraction.
>>>
V2 (V3 1 2 3) (V3 4 5 6) !-! V2 (V3 7 8 9) (V3 1 2 3)
V2 (V3 (-6) (-6) (-6)) (V3 3 3 3)
(!+!) :: (Additive m, Additive n, Num a) => m (n a) -> m (n a) -> m (n a) infixl 6 #
Entry-wise matrix addition.
>>>
V2 (V3 1 2 3) (V3 4 5 6) !+! V2 (V3 7 8 9) (V3 1 2 3)
V2 (V3 8 10 12) (V3 5 7 9)
(!*!) :: (Functor m, Foldable t, Additive t, Additive n, Num a) => m (t a) -> t (n a) -> m (n a) infixl 7 #
Matrix product. This can compute any combination of sparse and dense multiplication.
>>>
V2 (V3 1 2 3) (V3 4 5 6) !*! V3 (V2 1 2) (V2 3 4) (V2 4 5)
V2 (V2 19 25) (V2 43 58)
>>>
V2 (fromList [(1,2)]) (fromList [(2,3)]) !*! fromList [(1,V3 0 0 1), (2, V3 0 0 5)]
V2 (V3 0 0 2) (V3 0 0 15)
column :: forall (f :: Type -> Type) a b s t. Representable f => LensLike (Context a b) s t a b -> Lens (f s) (f t) (f a) (f b) #
frobenius :: (Num a, Foldable f, Additive f, Additive g, Distributive g, Trace g) => f (g a) -> a #
Compute the Frobenius norm of a matrix.
class Functor m => Trace (m :: Type -> Type) where #
Nothing
trace :: Num a => m (m a) -> a #
Compute the trace of a matrix
>>>
trace (V2 (V2 a b) (V2 c d))
a + d
Compute the diagonal of a matrix
>>>
diagonal (V2 (V2 a b) (V2 c d))
V2 a d
Instances
Trace Complex | |
Trace IntMap | |
Trace Plucker | |
Trace Quaternion | |
Defined in Linear.Trace trace :: Num a => Quaternion (Quaternion a) -> a # diagonal :: Quaternion (Quaternion a) -> Quaternion a # | |
Trace V0 | |
Trace V4 | |
Trace V3 | |
Trace V2 | |
Trace V1 | |
Ord k => Trace (Map k) | |
(Eq k, Hashable k) => Trace (HashMap k) | |
Dim n => Trace (V n) | |
(Trace f, Trace g) => Trace (Product f g) | |
(Distributive g, Trace g, Trace f) => Trace (Compose g f) | |
axisAngle :: (Epsilon a, Floating a) => V3 a -> a -> Quaternion a #
builds a axisAngle
axis thetaQuaternion
representing a
rotation of theta
radians about axis
.
slerp :: RealFloat a => Quaternion a -> Quaternion a -> a -> Quaternion a #
Spherical linear interpolation between two quaternions.
atanhq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a #
atanh
with a specified branch cut.
acoshq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a #
acosh
with a specified branch cut.
asinhq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a #
asinh
with a specified branch cut.
atanq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a #
atan
with a specified branch cut.
acosq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a #
acos
with a specified branch cut.
asinq :: RealFloat a => Quaternion a -> Quaternion a -> Quaternion a #
asin
with a specified branch cut.
pow :: RealFloat a => Quaternion a -> a -> Quaternion a #
raise a Quaternion
to a scalar power
absi :: Floating a => Quaternion a -> a #
norm of the imaginary component
data Quaternion a #
Quaternions
Quaternion !a !(V3 a) |
Instances
class Complicated (t :: Type -> Type) where #
Instances
Complicated Complex | |
Complicated Quaternion | |
Defined in Linear.Quaternion _e :: Lens' (Quaternion a) a # _i :: Lens' (Quaternion a) a # |
class Complicated t => Hamiltonian (t :: Type -> Type) where #
Instances
Hamiltonian Quaternion | |
Defined in Linear.Quaternion |
A 0-dimensional vector
>>>
pure 1 :: V0 Int
V0
>>>
V0 + V0
V0
Instances
normalizePoint :: Fractional a => V4 a -> V3 a #
Convert 4-dimensional projective coordinates to a 3-dimensional
point. This operation may be denoted, euclidean [x:y:z:w] = (x/w,
y/w, z/w)
where the projective, homogenous, coordinate
[x:y:z:w]
is one of many associated with a single point (x/w,
y/w, z/w)
.
point :: Num a => V3 a -> V4 a #
Convert a 3-dimensional affine point into a 4-dimensional homogeneous vector,
i.e. sets the w
coordinate to 1.
vector :: Num a => V3 a -> V4 a #
Convert a 3-dimensional affine vector into a 4-dimensional homogeneous vector,
i.e. sets the w
coordinate to 0.
A 4-dimensional vector.
V4 !a !a !a !a |
Instances
class R3 t => R4 (t :: Type -> Type) where #
Instances
R4 Quaternion | |
Defined in Linear.Quaternion _w :: Lens' (Quaternion a) a # _xyzw :: Lens' (Quaternion a) (V4 a) # | |
R4 V4 | |
R4 f => R4 (Point f) | |
A 3-dimensional vector
V3 !a !a !a |
Instances
class R2 t => R3 (t :: Type -> Type) where #
Instances
R3 Quaternion | |
Defined in Linear.Quaternion _z :: Lens' (Quaternion a) a # _xyz :: Lens' (Quaternion a) (V3 a) # | |
R3 V4 | |
R3 V3 | |
R3 f => R3 (Point f) | |
crossZ :: Num a => V2 a -> V2 a -> a #
The Z-component of the cross product of two vectors in the XY-plane.
>>>
crossZ (V2 1 0) (V2 0 1)
1
perp :: Num a => V2 a -> V2 a #
the counter-clockwise perpendicular vector
>>>
perp $ V2 10 20
V2 (-20) 10
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
V2 !a !a |
Instances
A 1-dimensional vector
>>>
pure 1 :: V1 Int
V1 1
>>>
V1 2 + V1 3
V1 5
>>>
V1 2 * V1 3
V1 6
>>>
sum (V1 2)
2
V1 a |
Instances
class R1 (t :: Type -> Type) where #
A space that has at least 1 basis vector _x
.
project :: (Metric v, Fractional a) => v a -> v a -> v a #
project u v
computes the projection of v
onto u
.
class Additive f => Metric (f :: Type -> Type) where #
Free and sparse inner product/metric spaces.
Nothing
dot :: Num a => f a -> f a -> a #
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
quadrance :: Num a => f a -> a #
Compute the squared norm. The name quadrance arises from Norman J. Wildberger's rational trigonometry.
qd :: Num a => f a -> f a -> a #
Compute the quadrance of the difference
distance :: Floating a => f a -> f a -> a #
Compute the distance between two vectors in a metric space
norm :: Floating a => f a -> a #
Compute the norm of a vector in a metric space
signorm :: Floating a => f a -> f a #
Convert a non-zero vector to unit vector.
Instances
Metric [] | |
Metric Maybe | |
Metric ZipList | |
Metric Identity | |
Defined in Linear.Metric | |
Metric IntMap | |
Metric Vector | |
Metric Plucker | |
Metric Quaternion | |
Defined in Linear.Quaternion dot :: Num a => Quaternion a -> Quaternion a -> a # quadrance :: Num a => Quaternion a -> a # qd :: Num a => Quaternion a -> Quaternion a -> a # distance :: Floating a => Quaternion a -> Quaternion a -> a # norm :: Floating a => Quaternion a -> a # signorm :: Floating a => Quaternion a -> Quaternion a # | |
Metric V0 | |
Metric V4 | |
Metric V3 | |
Metric V2 | |
Metric V1 | |
Ord k => Metric (Map k) | |
(Hashable k, Eq k) => Metric (HashMap k) | |
Defined in Linear.Metric | |
Metric f => Metric (Point f) | |
Dim n => Metric (V n) | |
(Metric f, Metric g) => Metric (Product f g) | |
(Metric f, Metric g) => Metric (Compose f g) | |
outer :: (Functor f, Functor g, Num a) => f a -> g a -> f (g a) #
Outer (tensor) product of two vectors
unit :: (Additive t, Num a) => ASetter' (t a) a -> t a #
Create a unit vector.
>>>
unit _x :: V2 Int
V2 1 0
scaled :: (Traversable t, Num a) => t a -> t (t a) #
Produce a diagonal (scale) matrix from a vector.
>>>
scaled (V2 2 3)
V2 (V2 2 0) (V2 0 3)
basisFor :: (Traversable t, Num a) => t b -> [t a] #
Produce a default basis for a vector space from which the argument is drawn.
basis :: (Additive t, Traversable t, Num a) => [t a] #
Produce a default basis for a vector space. If the dimensionality
of the vector space is not statically known, see basisFor
.
(^/) :: (Functor f, Fractional a) => f a -> a -> f a infixl 7 #
Compute division by a scalar on the right.
(^*) :: (Functor f, Num a) => f a -> a -> f a infixl 7 #
Compute the right scalar product
>>>
V2 3 4 ^* 2
V2 6 8
(*^) :: (Functor f, Num a) => a -> f a -> f a infixl 7 #
Compute the left scalar product
>>>
2 *^ V2 3 4
V2 6 8
sumV :: (Foldable f, Additive v, Num a) => f (v a) -> v a #
Sum over multiple vectors
>>>
sumV [V2 1 1, V2 3 4]
V2 4 5
negated :: (Functor f, Num a) => f a -> f a #
Compute the negation of a vector
>>>
negated (V2 2 4)
V2 (-2) (-4)
newtype E (t :: Type -> Type) #
Basis element
Instances
class Functor f => Additive (f :: Type -> Type) where #
A vector is an additive group with additional structure.
Nothing
The zero vector
(^+^) :: Num a => f a -> f a -> f a infixl 6 #
Compute the sum of two vectors
>>>
V2 1 2 ^+^ V2 3 4
V2 4 6
(^-^) :: Num a => f a -> f a -> f a infixl 6 #
Compute the difference between two vectors
>>>
V2 4 5 ^-^ V2 3 1
V2 1 4
lerp :: Num a => a -> f a -> f a -> f a #
Linearly interpolate between two vectors.
liftU2 :: (a -> a -> a) -> f a -> f a -> f a #
Apply a function to merge the 'non-zero' components of two vectors, unioning the rest of the values.
liftI2 :: (a -> b -> c) -> f a -> f b -> f c #
Apply a function to the components of two vectors.
- For a dense vector this is equivalent to
liftA2
. - For a sparse vector this is equivalent to
intersectionWith
.
Instances
class Num a => Epsilon a where #
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
Instances
Epsilon Double |
|
Defined in Linear.Epsilon | |
Epsilon Float |
|
Defined in Linear.Epsilon | |
Epsilon CFloat |
|
Defined in Linear.Epsilon | |
Epsilon CDouble |
|
Defined in Linear.Epsilon | |
(Epsilon a, RealFloat a) => Epsilon (Complex a) | |
Defined in Linear.Epsilon | |
Epsilon a => Epsilon (Plucker a) | |
Defined in Linear.Plucker | |
(RealFloat a, Epsilon a) => Epsilon (Quaternion a) | |
Defined in Linear.Quaternion nearZero :: Quaternion a -> Bool # | |
Epsilon (V0 a) | |
Epsilon a => Epsilon (V4 a) | |
Epsilon a => Epsilon (V3 a) | |
Epsilon a => Epsilon (V2 a) | |
Epsilon a => Epsilon (V1 a) | |
Epsilon (f a) => Epsilon (Point f a) | |
Defined in Linear.Affine | |
(Dim n, Epsilon a) => Epsilon (V n a) | |
class Num a => Conjugate a where #
An involutive ring
Nothing
Conjugate a value. This defaults to the trivial involution.
>>>
conjugate (1 :+ 2)
1.0 :+ (-2.0)
>>>
conjugate 1
1
Instances
Conjugate Double | |
Defined in Linear.Conjugate | |
Conjugate Float | |
Defined in Linear.Conjugate | |
Conjugate Int | |
Defined in Linear.Conjugate | |
Conjugate Int8 | |
Defined in Linear.Conjugate | |
Conjugate Int16 | |
Defined in Linear.Conjugate | |
Conjugate Int32 | |
Defined in Linear.Conjugate | |
Conjugate Int64 | |
Defined in Linear.Conjugate | |
Conjugate Integer | |
Defined in Linear.Conjugate | |
Conjugate Word | |
Defined in Linear.Conjugate | |
Conjugate Word8 | |
Defined in Linear.Conjugate | |
Conjugate Word16 | |
Defined in Linear.Conjugate | |
Conjugate Word32 | |
Defined in Linear.Conjugate | |
Conjugate Word64 | |
Defined in Linear.Conjugate | |
Conjugate CFloat | |
Defined in Linear.Conjugate | |
Conjugate CDouble | |
Defined in Linear.Conjugate | |
(Conjugate a, RealFloat a) => Conjugate (Complex a) | |
Defined in Linear.Conjugate | |
(Conjugate a, RealFloat a) => Conjugate (Quaternion a) | |
Defined in Linear.Quaternion conjugate :: Quaternion a -> Quaternion a # | |
Conjugate (S a Word) Source # | |
Conjugate (S a Int) Source # | |
Conjugate (S a Float) Source # | |
class Conjugate a => TrivialConjugate a #
Instances
getLinear :: (Binary a, Applicative t, Traversable t) => Get (t a) #
Deserialize a linear type.