| Safe Haskell | Safe |
|---|---|
| Language | Haskell2010 |
Data.Semimodule
Synopsis
- type (**) f g = Compose f g
- type (++) f g = Product f g
- 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)
- type FreeModule a f = (Free f, (Additive - Group) (f a), Bimodule a a (f a))
- type FreeSemimodule a f = (Free f, Bisemimodule a a (f a))
- type LeftModule l a = (Ring l, (Additive - Group) a, LeftSemimodule l a)
- class (Semiring l, (Additive - Monoid) a) => LeftSemimodule l a where
- lscale :: l -> a -> a
- (*.) :: LeftSemimodule l a => l -> a -> a
- (/.) :: Semifield a => Functor f => a -> f a -> f a
- (\.) :: Semifield a => Functor f => a -> f a -> f a
- lerp :: LeftModule r a => r -> a -> a -> a
- lscaleDef :: Semiring a => Functor f => a -> f a -> f a
- negateDef :: LeftModule Integer a => a -> a
- type RightModule r a = (Ring r, (Additive - Group) a, RightSemimodule r a)
- class (Semiring r, (Additive - Monoid) a) => RightSemimodule r a where
- rscale :: r -> a -> a
- (.*) :: RightSemimodule r a => a -> r -> a
- (./) :: Semifield a => Functor f => f a -> a -> f a
- (.\) :: Semifield a => Functor f => f a -> a -> f a
- rscaleDef :: Semiring a => Functor f => a -> f a -> f a
- type Bimodule l r a = (LeftModule l a, RightModule r a, Bisemimodule l r a)
- class (LeftSemimodule l a, RightSemimodule r a) => Bisemimodule l r a where
- discale :: l -> r -> a -> a
Types
type Free f = Representable f Source #
type FreeSemimodule a f = (Free f, Bisemimodule a a (f a)) Source #
Left modules
type LeftModule l a = (Ring l, (Additive - Group) a, LeftSemimodule l a) Source #
class (Semiring l, (Additive - Monoid) a) => LeftSemimodule l a where Source #
Left semimodule over a commutative semiring.
All instances must satisfy the following identities:
lscales (x+y) =lscales x+lscales ylscale(s1+s2) x =lscales1 x+lscales2 xlscale(s1*s2) =lscales1 .lscales2lscalezero=zero
When the ring of coefficients s is unital we must additionally have:
lscale one = id
See the properties module for a detailed specification of the laws.
Instances
(*.) :: LeftSemimodule l a => l -> a -> a infixr 7 Source #
Left-multiply a module element by a scalar.
(/.) :: Semifield a => Functor f => a -> f a -> f a infixr 7 Source #
Right-divide a vector by a scalar (on the left).
(\.) :: Semifield a => Functor f => a -> f a -> f a infixr 7 Source #
Left-divide a vector by a scalar.
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)
lscaleDef :: Semiring a => Functor f => a -> f a -> f a Source #
Default definition of lscale for a free module.
negateDef :: LeftModule Integer a => a -> a Source #
Default definition of << for a commutative group.
Right modules
type RightModule r a = (Ring r, (Additive - Group) a, RightSemimodule r a) Source #
class (Semiring r, (Additive - Monoid) a) => RightSemimodule r a where Source #
Right semimodule over a commutative semiring.
The laws for right semimodules are analagous to those of left semimodules.
See the properties module for a detailed specification.
Instances
(.*) :: RightSemimodule r a => a -> r -> a infixl 7 Source #
Right-multiply a module element by a scalar.
(./) :: Semifield a => Functor f => f a -> a -> f a infixl 7 Source #
Right-divide a vector by a scalar.
(.\) :: Semifield a => Functor f => f a -> a -> f a infixl 7 Source #
Left-divide a vector by a scalar (on the right).
rscaleDef :: Semiring a => Functor f => a -> f a -> f a Source #
Default definition of rscale for a free module.
Bimodules
type Bimodule l r a = (LeftModule l a, RightModule r a, Bisemimodule l r a) Source #
class (LeftSemimodule l a, RightSemimodule r a) => Bisemimodule l r a where Source #
Bisemimodule over a commutative semiring.
lscalel .rscaler =rscaler .lscalel
Minimal complete definition
Nothing