rings-0.1.3: Ring-like objects.

Safe HaskellSafe
LanguageHaskell2010

Data.Semimodule.Combinator

Contents

Synopsis

Vector accessors and constructors

elt :: Free f => Rep f -> f a -> a Source #

Retrieve the coefficient of a basis element

>>> elt E21 (V2 1 2)
1

vec :: Free f => f a -> Vec a (Rep f) Source #

Obtain a vector from an array of coefficients and a basis.

cov :: FreeCounital a f => f a -> Cov a (Rep f) Source #

Obtain a covector from an array of coefficients and a basis.

>>> cov (V2 7 4) !* vec (V2 1 2) :: Int
11

unit :: FreeUnital a f => a -> f a Source #

Insert an element into an algebra.

When the algebra is trivial this is equal to pureRep.

>>> V4 1 2 3 4 .*. unit two :: V4 Int
V4 2 4 6 8

unit' :: FreeUnital a f => f a Source #

Unital element of a unital algebra over a free semimodule.

>>> unit' :: Complex Int
1 :+ 0

counit :: FreeCounital a f => f a -> a Source #

Obtain an element from a coalgebra over a free semimodule.

dirac :: Semiring a => Free f => Eq (Rep f) => Rep f -> f a Source #

Create a unit vector at an index.

>>> dirac E21 :: V2 Int
V2 1 0
>>> dirac E42 :: V4 Int
V4 0 1 0 0

lensRep :: Free f => Eq (Rep f) => Rep f -> forall g. Functor g => (a -> g a) -> f a -> g (f a) Source #

Create a lens from a representable functor.

grateRep :: Free f => forall g. Functor g => (Rep f -> g a1 -> a2) -> g (f a1) -> f a2 Source #

Create an indexed grate from a representable functor.

Vector combinators

(.*) :: RightSemimodule r a => a -> r -> a infixl 7 Source #

Right-multiply a module element by a scalar.

(*.) :: LeftSemimodule l a => l -> a -> a infixr 7 Source #

Left-multiply a module element by a scalar.

(.*.) :: FreeAlgebra a f => f a -> f a -> f a infixl 7 Source #

Multiplication operator on an algebra over a free semimodule.

Caution in general .*. needn't be commutative, nor associative.

(!*) :: Vec a b -> Cov a b -> a infixr 7 Source #

Apply a covector to a vector on the right.

(*!) :: Cov a b -> Vec a b -> a infixl 7 Source #

Apply a covector to a vector on the left.

(!*!) :: Algebra a b => Vec a b -> Vec a b -> Vec a b infixr 7 Source #

Multiplication operator on an algebra over a free semimodule.

>>> flip runVec E22 $ (vec $ V2 1 2) !*! (vec $ V2 7 4)
8

Caution in general mult needn't be commutative, nor associative.

vmap :: Lin a b c -> Vec a c -> Vec a b Source #

Use a linear transformation to map over a vector space.

Note that the basis transforms https://en.wikipedia.org/wiki/Covariant_transformation#Contravariant_transformation contravariantly.

cmap :: Lin a b c -> Cov a b -> Cov a c Source #

Use a linear transformation to map over a dual space.

Note that the basis transforms covariantly.

inner :: FreeCounital a f => f a -> f a -> a infix 6 Source #

Inner product.

When the coalgebra is trivial this is a variant of xmult restricted to free functors.

>>> V3 1 2 3 `inner` V3 1 2 3
14

outer :: Semiring a => Free f => Free g => f a -> g a -> (f ** g) a Source #

Outer product.

>>> V2 1 1 `outer` V2 1 1
Compose (V2 (V2 1 1) (V2 1 1))

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 v
V3 (6 % 4) (12 % 4) (18 % 4)

quadrance :: FreeCounital a f => f a -> a Source #

Squared l2 norm of a vector.

Matrix accessors and constructors

lin :: Free f => FreeCounital a g => (f ** g) a -> Lin a (Rep f) (Rep g) Source #

Obtain a linear linsformation from a matrix.

 (.#) = (!#) . lin

elt2 :: Free f => Free g => Rep f -> Rep g -> (f ** g) a -> a Source #

Retrieve an element of a matrix.

>>> elt2 E21 E21 $ m22 1 2 3 4
1

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 6
V3 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 Int
V2 (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 6
4

cols :: Free f => Free g => f a -> (f ** g) a Source #

Obtain a matrix by stacking columns.

>>> cols (V2 1 2) :: M22 Int
V2 (V2 1 1) (V2 2 2)

diag :: FreeAlgebra a f => (f ** f) a -> f a Source #

Obtain a vector from a tensor.

When the algebra is trivial we have:

 diag f = tabulate $ joined (index . index (getCompose f))
>>> diag $ m22 1.0 2.0 3.0 4.0
V2 1.0 4.0

codiag :: FreeCoalgebra a f => f a -> (f ** f) a Source #

Obtain a tensor from a vector.

When the coalgebra is trivial we have:

 codiag = flip bindRep id . getCompose

scalar :: FreeCoalgebra a f => a -> (f ** f) a Source #

Obtain a scalar matrix from a scalar.

>>> scalar 4.0 :: M22 Double
Compose (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 Int
Compose (V3 (V3 1 0 0) (V3 0 1 0) (V3 0 0 1))

Matrix combinators

(.#) :: Free f => FreeCounital a g => (f ** g) a -> g a -> f a infixr 7 Source #

Multiply a matrix on the right by a column vector.

 (.#) = (!#) . lin
>>> lin (m23 1 2 3 4 5 6) !# V3 7 8 9 :: V2 Int
V2 50 122
>>> m23 1 2 3 4 5 6 .# V3 7 8 9 :: V2 Int
V2 50 122
>>> m22 1 0 0 0 .# m23 1 2 3 4 5 6 .# V3 7 8 9 :: V2 Int
V2 50 0

(#.) :: 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 8
V3 15 18 21
>>> V2 1 2 #. m23 3 4 5 6 7 8 #. m32 1 0 0 0 0 0 :: V2 Int
V2 15 0

(#!) :: Free f => Free g => g a -> Lin a (Rep f) (Rep g) -> f a infixl 2 Source #

Apply a transformation to a vector.

(!#) :: Free f => Free g => Lin a (Rep f) (Rep g) -> g a -> f a infixr 2 Source #

Apply a transformation to a vector.

(.#.) :: 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 Int
Compose (V2 (V2 7 10) (V2 15 22))
>>> m23 1 2 3 4 5 6 .#. m32 1 2 3 4 4 5 :: M22 Int
Compose (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.0
5.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 Int
V3 (V2 1 4) (V2 2 5) (V2 3 6)