Copyright | (c) Erich Gut |
---|---|
License | BSD3 |
Maintainer | zerich.gut@gmail.com |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
free products of symbols in x
with index type N
.
Synopsis
- newtype ProductSymbol x = ProductSymbol (Product N (U x))
- sy :: Entity x => x -> ProductSymbol x
- psyShow :: Entity x => ProductSymbol x -> String
- psyxs :: ProductSymbol x -> [(x, N)]
- psywrd :: Entity x => ProductSymbol x -> Word N x
- wrdpsy :: Entity x => Word N x -> ProductSymbol x
- nProxy :: Proxy N
- psyJoin :: Entity x => ProductSymbol (ProductSymbol x) -> ProductSymbol x
- productSymbol :: Entity x => [x] -> ProductSymbol x
- psyLength :: ProductSymbol x -> N
- psyFactor :: ProductSymbol x -> N -> x
- psyMap :: Entity y => (x -> y) -> ProductSymbol x -> ProductSymbol y
- newtype U x = U x
- fromU :: U x -> x
- xProductSymbol :: Entity x => N -> X x -> X (ProductSymbol x)
ProductSymbol
newtype ProductSymbol x Source #
free product of symbols in x
with index type N
.
Example
The expression
constructs a free product of exactly one symbol in sy
'a'Char
consisting just of the character 'a'
.
>>>
sy 'a'
ProductSymbol['a']
they are Total
Multiplicative
>>>
sy 'a' * sy 'b' * sy 'c'
ProductSymbol['a'*'b'*'c']
and admit a listing
>>>
list (Proxy :: Proxy N) (sy 'a' * sy 'b' * sy 'c')
[('a',0),('b',1),('c',2)]
they have a compact representation for repetitions
>>>
sy 'a' * sy 'b' * sy 'b' * sy 'a' * sy 'c'
ProductSymbol['a'*'b'^2*'a'*'c']
>>>
sy 'a' * sy 'b' * sy 'b' * sy 'a' * sy 'c' == sy 'a' * sy 'b' ^ 2 * sy 'a' * sy 'c'
True
but they are not Commutative
>>>
sy 'a' * sy 'b' ^ 2 * sy 'a' * sy 'c' == sy 'a' ^ 2 * sy 'b' ^ 2 * sy 'c'
False
and they admit a total right operation <*
of
Permutation
N
>>>
(sy 'a' * sy 'b' ^ 2 * sy 'a' * sy 'c') <* (pmtSwap 1 3 :: Permutation N)
ProductSymbol['a'^2*'b'^2*'c']
Note
- Free products of symbols are finite complete sequences and allow a compact representation for repetitions and serve merely as dimensions for matrices (see OAlg.Entity.Matrix.Dim).
- Possibly infinite complete sequences are represented by
[x]
.
ProductSymbol (Product N (U x)) |
Instances
sy :: Entity x => x -> ProductSymbol x Source #
symbol of an entity, i.e. the complete sequence of psyLength
one consisting
just of it.
Example
>>>
sy 'a'
ProductSymbol['a']
>>>
sy 'a' * sy 'b' * sy 'b' ^ 5 * sy 'c'
ProductSymbol['a'*'b'^6*'c']
psyxs :: ProductSymbol x -> [(x, N)] Source #
the indexed listing of the symbols.
psyJoin :: Entity x => ProductSymbol (ProductSymbol x) -> ProductSymbol x Source #
joining complete sequences.
productSymbol :: Entity x => [x] -> ProductSymbol x Source #
the induced product of symbols.
psyLength :: ProductSymbol x -> N Source #
the length of a complete sequence.
psyFactor :: ProductSymbol x -> N -> x Source #
the symbol for the given index.
psyMap :: Entity y => (x -> y) -> ProductSymbol x -> ProductSymbol y Source #
mapping free products of symbols.
U
adjoins the point ()
to an entity.
Note Serves to build sums or products over symbols in x
.
U x |
Instances
Foldable U Source # | |
Defined in OAlg.Entity.Product.ProductSymbol fold :: Monoid m => U m -> m # foldMap :: Monoid m => (a -> m) -> U a -> m # foldMap' :: Monoid m => (a -> m) -> U a -> m # foldr :: (a -> b -> b) -> b -> U a -> b # foldr' :: (a -> b -> b) -> b -> U a -> b # foldl :: (b -> a -> b) -> b -> U a -> b # foldl' :: (b -> a -> b) -> b -> U a -> b # foldr1 :: (a -> a -> a) -> U a -> a # foldl1 :: (a -> a -> a) -> U a -> a # elem :: Eq a => a -> U a -> Bool # maximum :: Ord a => U a -> a # | |
Functor U Source # | |
Show x => Show (U x) Source # | |
Eq x => Eq (U x) Source # | |
Ord x => Ord (U x) Source # | |
Validable x => Validable (U x) Source # | |
Entity x => Entity (U x) Source # | |
Defined in OAlg.Entity.Product.ProductSymbol | |
OrdPoint (U x) Source # | |
Defined in OAlg.Entity.Product.ProductSymbol | |
Entity x => Oriented (U x) Source # | |
type Point (U x) Source # | |
Defined in OAlg.Entity.Product.ProductSymbol |
X
xProductSymbol :: Entity x => N -> X x -> X (ProductSymbol x) Source #
random variable of complete sequences with the given maximal length.