Safe Haskell | None |
---|---|
Language | Haskell98 |
- newtype Map r b a = Map ((a -> r) -> b -> r)
- ($@) :: Map r b a -> b -> Covector r a
- multMap :: Coalgebra r c => Map r (c, c) c
- unitMap :: CounitalCoalgebra r c => Map r () c
- comultMap :: Algebra r a => Map r a (a, a)
- counitMap :: UnitalAlgebra r a => Map r a ()
- invMap :: InvolutiveCoalgebra r c => Map r c c
- coinvMap :: InvolutiveAlgebra r a => Map r a a
- antipodeMap :: HopfAlgebra r h => Map r h h
- convolveMap :: (Algebra r a, Coalgebra r c) => Map r a c -> Map r a c -> Map r a c
Documentation
linear maps from elements of a free module to another free module over r
f $# x + y = (f $# x) + (f $# y) f $# (r .* x) = r .* (f $# x)
Map r b a
represents a linear mapping from a free module with basis a
over r
to a free module with basis b
over r
.
Note well the reversed direction of the arrow, due to the contravariance of change of basis!
This way enables we can employ arbitrary pure functions as linear maps by lifting them using arr
, or build them
by using the monad instance for Map r b. As a consequence Map is an instance of, well, almost everything.
Map ((a -> r) -> b -> r) |
($@) :: Map r b a -> b -> Covector r a infixr 0 Source #
extract a linear functional from a linear map
unitMap :: CounitalCoalgebra r c => Map r () c Source #
comultMap :: Algebra r a => Map r a (a, a) Source #
(inefficiently) combine a linear combination of basis vectors to make a map. arrMap :: (Monoidal r, Semiring r) => (b -> [(r, a)]) -> Map r b a arrMap f = Map $ k b -> sum [ r * k a | (r, a) <- f b ]
counitMap :: UnitalAlgebra r a => Map r a () Source #
invMap :: InvolutiveCoalgebra r c => Map r c c Source #
coinvMap :: InvolutiveAlgebra r a => Map r a a Source #
antipodeMap :: HopfAlgebra r h => Map r h h Source #