| Safe Haskell | Safe |
|---|---|
| Language | Haskell2010 |
Data.Semimodule.Free
Contents
Synopsis
- type Free f = Representable f
- type Basis b f = (Free f, Rep f ~ b, Eq b)
- type Basis2 b c f g = (Basis b f, Basis c g)
- type Basis3 b c d f g h = (Basis b f, Basis c g, Basis d h)
- (.*) :: RightSemimodule r a => a -> r -> a
- (!*) :: Free f => Dual a (Rep f) -> f a -> a
- (.#) :: Free f => FreeCounital a g => (f ** g) a -> g a -> f a
- (!#) :: Free f => Free g => Tran a (Rep f) (Rep g) -> g a -> f a
- (*.) :: LeftSemimodule l a => l -> a -> a
- (*!) :: Free f => f a -> Dual a (Rep f) -> a
- (#.) :: FreeCounital a f => Free g => f a -> (f ** g) a -> g a
- (#!) :: Free f => Free g => g a -> Tran a (Rep f) (Rep g) -> f a
- dual :: FreeCounital a f => f a -> Dual a (Rep f)
- inner :: FreeCounital a f => f a -> f a -> a
- lerp :: LeftModule r a => r -> a -> a -> a
- quadrance :: FreeCounital a f => f a -> a
- cross :: Ring a => V3 a -> V3 a -> V3 a
- triple :: Ring a => V3 a -> V3 a -> V3 a -> a
- dirac :: Eq i => Semiring a => i -> i -> a
- idx :: Semiring a => Basis b f => b -> f a
- elt :: Basis b f => b -> f a -> a
- lensRep :: Basis b f => b -> forall g. Functor g => (a -> g a) -> f a -> g (f a)
- grateRep :: Basis b f => forall g. Functor g => (b -> g a1 -> a2) -> g (f a1) -> f a2
- (.#.) :: Free f => FreeCounital a g => Free h => (f ** g) a -> (g ** h) a -> (f ** h) a
- (!#!) :: Tran a c d -> Tran a b c -> Tran a b d
- trace :: FreeBialgebra a f => (f ** f) a -> a
- transpose :: Free f => Free g => (f ** g) a -> (g ** f) a
- inv1 :: Field a => M11 a -> M11 a
- inv2 :: Field a => M22 a -> M22 a
- bdet2 :: Semiring a => Basis2 E2 E2 f g => (f ** g) a -> (a, a)
- det2 :: Ring a => Basis2 E2 E2 f g => (f ** g) a -> a
- bdet3 :: Semiring a => Basis2 E3 E3 f g => (f ** g) a -> (a, a)
- det3 :: Ring a => Basis2 E3 E3 f g => (f ** g) a -> a
- inv3 :: Field a => M33 a -> M33 a
- bdet4 :: Semiring a => Basis2 E4 E4 f g => (f ** g) a -> (a, a)
- det4 :: Ring a => Basis2 E4 E4 f g => (f ** g) a -> a
- inv4 :: Field a => M44 a -> M44 a
- tran :: Free f => FreeCounital a g => (f ** g) a -> Tran a (Rep f) (Rep g)
- elt2 :: Basis2 b c f g => b -> c -> (f ** g) a -> a
- row :: Free f => Rep f -> (f ** g) a -> g a
- rows :: Free f => Free g => g a -> (f ** g) a
- col :: Free f => Free g => Rep g -> (f ** g) a -> f a
- cols :: Free f => Free g => f a -> (f ** g) a
- diag :: FreeCoalgebra a f => f a -> (f ** f) a
- codiag :: FreeAlgebra a f => (f ** f) a -> f a
- outer :: Semiring a => Free f => Free g => f a -> g a -> (f ** g) a
- scalar :: FreeCoalgebra a f => a -> (f ** f) a
- identity :: FreeCoalgebra a f => (f ** f) a
- newtype V1 a = V1 a
- unV1 :: V1 a -> a
- data V2 a = V2 !a !a
- data V3 a = V3 !a !a !a
- data V4 a = V4 !a !a !a !a
- type M11 = Compose V1 V1
- type M12 = Compose V1 V2
- type M13 = Compose V1 V3
- type M14 = Compose V1 V4
- type M21 = Compose V2 V1
- type M31 = Compose V3 V1
- type M41 = Compose V4 V1
- type M22 = Compose V2 V2
- type M23 = Compose V2 V3
- type M24 = Compose V2 V4
- type M32 = Compose V3 V2
- type M33 = Compose V3 V3
- type M34 = Compose V3 V4
- type M42 = Compose V4 V2
- type M43 = Compose V4 V3
- type M44 = Compose V4 V4
- m11 :: a -> M11 a
- m12 :: a -> a -> M12 a
- m13 :: a -> a -> a -> M13 a
- m14 :: a -> a -> a -> a -> M14 a
- m21 :: a -> a -> M21 a
- m31 :: a -> a -> a -> M31 a
- m41 :: a -> a -> a -> a -> M41 a
- m22 :: a -> a -> a -> a -> M22 a
- m23 :: a -> a -> a -> a -> a -> a -> M23 a
- m24 :: a -> a -> a -> a -> a -> a -> a -> a -> M24 a
- m32 :: a -> a -> a -> a -> a -> a -> M32 a
- m33 :: a -> a -> a -> a -> a -> a -> a -> a -> a -> M33 a
- m34 :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> M34 a
- m42 :: a -> a -> a -> a -> a -> a -> a -> a -> M42 a
- m43 :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> M43 a
- m44 :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> M44 a
Types
type Free f = Representable f Source #
Vector arithmetic
(.*) :: RightSemimodule r a => a -> r -> a infixl 7 Source #
Right-multiply a module element by a scalar.
(!*) :: Free f => Dual a (Rep f) -> f a -> a infixr 3 Source #
Apply a linear functional to a vector.
(!#) :: Free f => Free g => Tran a (Rep f) (Rep g) -> g a -> f a infixr 2 Source #
Apply a transformation to a vector.
(*.) :: LeftSemimodule l a => l -> a -> a infixr 7 Source #
Left-multiply a module element by a scalar.
(*!) :: Free f => f a -> Dual a (Rep f) -> a infixl 3 Source #
Apply a linear functional to a vector.
(#.) :: FreeCounital a f => Free g => f a -> (f ** g) a -> g a infixl 7 Source #
Multiply a matrix on the left by a row vector.
>>>V2 1 2 #. m23 3 4 5 6 7 8V3 15 18 21
>>>V2 1 2 #. m23 3 4 5 6 7 8 #. m32 1 0 0 0 0 0 :: V2 IntV2 15 0
(#!) :: Free f => Free g => g a -> Tran a (Rep f) (Rep g) -> f a infixl 2 Source #
Apply a transformation to a vector.
dual :: FreeCounital a f => f a -> Dual a (Rep f) Source #
Take the dual of a vector.
>>>dual (V2 3 4) !% V2 1 2 :: Int11
inner :: FreeCounital a f => f a -> f a -> a infix 6 Source #
Inner product.
This is a variant of xmult restricted to free functors.
>>>V3 1 2 3 `inner` V3 1 2 314
lerp :: LeftModule r a => r -> a -> a -> a Source #
Linearly interpolate between two vectors.
>>>u = V3 (1 :% 1) (2 :% 1) (3 :% 1) :: V3 Rational>>>v = V3 (2 :% 1) (4 :% 1) (6 :% 1) :: V3 Rational>>>r = 1 :% 2 :: Rational>>>lerp r u vV3 (6 % 4) (12 % 4) (18 % 4)
quadrance :: FreeCounital a f => f a -> a Source #
Squared l2 norm of a vector.
cross :: Ring a => V3 a -> V3 a -> V3 a Source #
Cross product.
a `cross'a =zeroa `cross'b =negate( b `cross'a ) , a `cross'( b+c ) = ( a `cross'b )+( a `cross'c ) , ( r a ) `cross'b = a `cross'( r b ) = r ( a `cross'b ) . a `cross'( b `cross'c )+b `cross'( c `cross'a )+c `cross'( a `cross'b ) =zero.
See Jacobi identity.
Vector accessors and constructors
idx :: Semiring a => Basis b f => b -> f a Source #
Create a unit vector at an index.
>>>idx E21 :: V2 IntV2 1 0
>>>idx E42 :: V4 IntV4 0 1 0 0
lensRep :: Basis b f => b -> forall g. Functor g => (a -> g a) -> f a -> g (f a) Source #
Create a lens from a representable functor.
grateRep :: Basis b f => forall g. Functor g => (b -> g a1 -> a2) -> g (f a1) -> f a2 Source #
Create an indexed grate from a representable functor.
Matrix arithmetic
(.#.) :: Free f => FreeCounital a g => Free h => (f ** g) a -> (g ** h) a -> (f ** h) a infixr 7 Source #
Multiply two matrices.
>>>m22 1 2 3 4 .#. m22 1 2 3 4 :: M22 IntCompose (V2 (V2 7 10) (V2 15 22))
>>>m23 1 2 3 4 5 6 .#. m32 1 2 3 4 4 5 :: M22 IntCompose (V2 (V2 19 25) (V2 43 58))
trace :: FreeBialgebra a f => (f ** f) a -> a Source #
Trace of an endomorphism.
>>>trace $ m22 1.0 2.0 3.0 4.05.0
transpose :: Free f => Free g => (f ** g) a -> (g ** f) a Source #
Transpose a matrix.
>>>transpose $ m23 1 2 3 4 5 6 :: M32 IntV3 (V2 1 4) (V2 2 5) (V2 3 6)
inv1 :: Field a => M11 a -> M11 a Source #
1x1 matrix inverse over a field.
>>>inv1 $ m11 4.0 :: M11 DoubleCompose (V1 (V1 0.25))
inv2 :: Field a => M22 a -> M22 a Source #
2x2 matrix inverse over a field.
>>>inv2 $ m22 1 2 3 4 :: M22 DoubleCompose (V2 (V2 (-2.0) 1.0) (V2 1.5 (-0.5)))
bdet2 :: Semiring a => Basis2 E2 E2 f g => (f ** g) a -> (a, a) Source #
2x2 matrix bdeterminant over a commutative semiring.
>>>bdet2 $ m22 1 2 3 4(4,6)
bdet3 :: Semiring a => Basis2 E3 E3 f g => (f ** g) a -> (a, a) Source #
3x3 matrix bdeterminant over a commutative semiring.
>>>bdet3 (V3 (V3 1 2 3) (V3 4 5 6) (V3 7 8 9))(225, 225)
inv3 :: Field a => M33 a -> M33 a Source #
3x3 matrix inverse.
>>>inv3 $ m33 1 2 4 4 2 2 1 1 1 :: M33 DoubleCompose (V3 (V3 0.0 0.5 (-1.0)) (V3 (-0.5) (-0.75) 3.5) (V3 0.5 0.25 (-1.5)))
bdet4 :: Semiring a => Basis2 E4 E4 f g => (f ** g) a -> (a, a) Source #
4x4 matrix bdeterminant over a commutative semiring.
>>>bdet4 $ m44 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16(27728,27728)
inv4 :: Field a => M44 a -> M44 a Source #
4x4 matrix inverse.
>>>row E41 . inv4 $ m44 1 0 3 2 2 0 2 1 0 0 0 1 0 3 4 0 :: V4 RationalV4 (6 % (-12)) ((-9) % (-12)) ((-3) % (-12)) (0 % (-12))
Matrix accessors and constructors
elt2 :: Basis2 b c f g => b -> c -> (f ** g) a -> a Source #
Retrieve an element of a matrix.
>>>elt2 E21 E21 $ m22 1 2 3 41
row :: Free f => Rep f -> (f ** g) a -> g a Source #
Retrieve a row of a matrix.
>>>row E22 $ m23 1 2 3 4 5 6V3 4 5 6
rows :: Free f => Free g => g a -> (f ** g) a Source #
Obtain a matrix by stacking rows.
>>>rows (V2 1 2) :: M22 IntV2 (V2 1 2) (V2 1 2)
col :: Free f => Free g => Rep g -> (f ** g) a -> f a Source #
Retrieve a column of a matrix.
>>>elt E22 . col E31 $ m23 1 2 3 4 5 64
cols :: Free f => Free g => f a -> (f ** g) a Source #
Obtain a matrix by stacking columns.
>>>cols (V2 1 2) :: M22 IntV2 (V2 1 1) (V2 2 2)
diag :: FreeCoalgebra a f => f a -> (f ** f) a Source #
Obtain a diagonal matrix from a vector.
diag=flipbindRepid.getCompose
codiag :: FreeAlgebra a f => (f ** f) a -> f a Source #
outer :: Semiring a => Free f => Free g => f a -> g a -> (f ** g) a Source #
Outer product.
>>>V2 1 1 `outer` V2 1 1Compose (V2 (V2 1 1) (V2 1 1))
scalar :: FreeCoalgebra a f => a -> (f ** f) a Source #
Obtain a scalar matrix from a scalar.
>>>scalar 4.0 :: M22 DoubleCompose (V2 (V2 4.0 0.0) (V2 0.0 4.0))
identity :: FreeCoalgebra a f => (f ** f) a Source #
Obtain an identity matrix.
>>>identity :: M33 IntCompose (V3 (V3 1 0 0) (V3 0 1 0) (V3 0 0 1))
Vector types
Constructors
| V1 a |
Instances
Constructors
| V2 !a !a |
Instances
Constructors
| V3 !a !a !a |
Instances
Constructors
| V4 !a !a !a !a |
Instances
Matrix types
m13 :: a -> a -> a -> M13 a Source #
Construct a 1x3 matrix.
>>>m13 1 2 3 :: M13 IntCompose (V1 (V3 1 2 3))
m14 :: a -> a -> a -> a -> M14 a Source #
Construct a 1x4 matrix.
>>>m14 1 2 3 4 :: M14 IntCompose (V1 (V4 1 2 3 4))
m21 :: a -> a -> M21 a Source #
Construct a 2x1 matrix.
>>>m21 1 2 :: M21 IntCompose (V2 (V1 1) (V1 2))
m31 :: a -> a -> a -> M31 a Source #
Construct a 3x1 matrix.
>>>m31 1 2 3 :: M31 IntCompose (V3 (V1 1) (V1 2) (V1 3))
m41 :: a -> a -> a -> a -> M41 a Source #
Construct a 4x1 matrix.
>>>m41 1 2 3 4 :: M41 IntCompose (V4 (V1 1) (V1 2) (V1 3) (V1 4))
m22 :: a -> a -> a -> a -> M22 a Source #
Construct a 2x2 matrix.
Arguments are in row-major order.
>>>m22 1 2 3 4 :: M22 IntCompose (V2 (V2 1 2) (V2 3 4))
m23 :: a -> a -> a -> a -> a -> a -> M23 a Source #
Construct a 2x3 matrix.
Arguments are in row-major order.
m24 :: a -> a -> a -> a -> a -> a -> a -> a -> M24 a Source #
Construct a 2x4 matrix.
Arguments are in row-major order.
m32 :: a -> a -> a -> a -> a -> a -> M32 a Source #
Construct a 3x2 matrix.
Arguments are in row-major order.
m33 :: a -> a -> a -> a -> a -> a -> a -> a -> a -> M33 a Source #
Construct a 3x3 matrix.
Arguments are in row-major order.
m34 :: a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> M34 a Source #
Construct a 3x4 matrix.
Arguments are in row-major order.
m42 :: a -> a -> a -> a -> a -> a -> a -> a -> M42 a Source #
Construct a 4x2 matrix.
Arguments are in row-major order.