{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveFunctor, DeriveFoldable, GeneralizedNewtypeDeriving #-}

-- |
-- Module      : OAlg.Entity.Sequence.ProductSymbol
-- Description : free products of symbols
-- Copyright   : (c) Erich Gut
-- License     : BSD3
-- Maintainer  : zerich.gut@gmail.com
--
-- free products of symbols in @__x__@ with index type 'N'.
module OAlg.Entity.Product.ProductSymbol
  (
    -- * ProductSymbol
    ProductSymbol(..), sy, psyShow
  , psyxs, psywrd,wrdpsy, nProxy
  , psyJoin
  , productSymbol, psyLength, psyFactor
  , psyMap
  
    -- * U
  , U(..), fromU

    -- * X
  , xProductSymbol
  ) where

import Control.Monad

import Data.Typeable
import Data.Foldable
import Data.List (map,(++),filter)

import OAlg.Prelude

import OAlg.Data.Constructable

import OAlg.Structure.Oriented
import OAlg.Structure.Multiplicative
import OAlg.Structure.Exponential

import OAlg.Entity.Product.Definition
import OAlg.Entity.Sequence.Definition
import OAlg.Entity.Sequence.Set

--------------------------------------------------------------------------------
-- U -

-- | adjoins the point @()@ to an entity.
--
--  __Note__ Serves to build sums or products over symbols in @__x__@.
newtype U x = U x deriving (U x -> U x -> Bool
forall x. Eq x => U x -> U x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: U x -> U x -> Bool
$c/= :: forall x. Eq x => U x -> U x -> Bool
== :: U x -> U x -> Bool
$c== :: forall x. Eq x => U x -> U x -> Bool
Eq,U x -> U x -> Bool
U x -> U x -> Ordering
U x -> U x -> U x
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {x}. Ord x => Eq (U x)
forall x. Ord x => U x -> U x -> Bool
forall x. Ord x => U x -> U x -> Ordering
forall x. Ord x => U x -> U x -> U x
min :: U x -> U x -> U x
$cmin :: forall x. Ord x => U x -> U x -> U x
max :: U x -> U x -> U x
$cmax :: forall x. Ord x => U x -> U x -> U x
>= :: U x -> U x -> Bool
$c>= :: forall x. Ord x => U x -> U x -> Bool
> :: U x -> U x -> Bool
$c> :: forall x. Ord x => U x -> U x -> Bool
<= :: U x -> U x -> Bool
$c<= :: forall x. Ord x => U x -> U x -> Bool
< :: U x -> U x -> Bool
$c< :: forall x. Ord x => U x -> U x -> Bool
compare :: U x -> U x -> Ordering
$ccompare :: forall x. Ord x => U x -> U x -> Ordering
Ord,Int -> U x -> ShowS
forall x. Show x => Int -> U x -> ShowS
forall x. Show x => [U x] -> ShowS
forall x. Show x => U x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [U x] -> ShowS
$cshowList :: forall x. Show x => [U x] -> ShowS
show :: U x -> String
$cshow :: forall x. Show x => U x -> String
showsPrec :: Int -> U x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> U x -> ShowS
Show,forall a b. a -> U b -> U a
forall a b. (a -> b) -> U a -> U b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> U b -> U a
$c<$ :: forall a b. a -> U b -> U a
fmap :: forall a b. (a -> b) -> U a -> U b
$cfmap :: forall a b. (a -> b) -> U a -> U b
Functor,U x -> Statement
forall x. Validable x => U x -> Statement
forall a. (a -> Statement) -> Validable a
valid :: U x -> Statement
$cvalid :: forall x. Validable x => U x -> Statement
Validable,forall a. Eq a => a -> U a -> Bool
forall a. Num a => U a -> a
forall a. Ord a => U a -> a
forall m. Monoid m => U m -> m
forall a. U a -> Bool
forall a. U a -> Int
forall a. U a -> [a]
forall a. (a -> a -> a) -> U a -> a
forall m a. Monoid m => (a -> m) -> U a -> m
forall b a. (b -> a -> b) -> b -> U a -> b
forall a b. (a -> b -> b) -> b -> U a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => U a -> a
$cproduct :: forall a. Num a => U a -> a
sum :: forall a. Num a => U a -> a
$csum :: forall a. Num a => U a -> a
minimum :: forall a. Ord a => U a -> a
$cminimum :: forall a. Ord a => U a -> a
maximum :: forall a. Ord a => U a -> a
$cmaximum :: forall a. Ord a => U a -> a
elem :: forall a. Eq a => a -> U a -> Bool
$celem :: forall a. Eq a => a -> U a -> Bool
length :: forall a. U a -> Int
$clength :: forall a. U a -> Int
null :: forall a. U a -> Bool
$cnull :: forall a. U a -> Bool
toList :: forall a. U a -> [a]
$ctoList :: forall a. U a -> [a]
foldl1 :: forall a. (a -> a -> a) -> U a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> U a -> a
foldr1 :: forall a. (a -> a -> a) -> U a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> U a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> U a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> U a -> b
foldl :: forall b a. (b -> a -> b) -> b -> U a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> U a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> U a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> U a -> b
foldr :: forall a b. (a -> b -> b) -> b -> U a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> U a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> U a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> U a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> U a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> U a -> m
fold :: forall m. Monoid m => U m -> m
$cfold :: forall m. Monoid m => U m -> m
Foldable)

instance Entity x => Entity (U x)

instance Entity x => Oriented (U x) where
  type Point (U x) = ()
  orientation :: U x -> Orientation (Point (U x))
orientation = forall b a. b -> a -> b
const (()forall p. p -> p -> Orientation p
:>())

instance OrdPoint (U x)

{-
instance Total (U a)

instance Singelton a => Singelton (U a) where
  unit = U unit

-- | gets the wraped 'a'.
fromU :: U a -> a
fromU (U a) = a

instance (Multiplicative a, Total a) => Multiplicative (U a) where
  one () = U (one unit)
  U a * U b = U (a*b)

instance Foldable U where
  foldr (*>) b (U a) = a*>b
-}  

-- | deconstructor.
fromU :: U x -> x
fromU :: forall x. U x -> x
fromU (U x
x) = x
x

--------------------------------------------------------------------------------
-- ProductSymbol -

-- | free product of symbols in @__x__@ with index type 'N'.
--
--  __Example__
--
-- The expression @'sy' \'a\'@ constructs a free product of exactly one symbol in '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 'OAlg.Structure.Operational.<*' of
-- @t'OAlg.Entity.Sequence.Permutation.Permutation' 'N'@
--
-- >>> (sy 'a' * sy 'b' ^ 2 * sy 'a' * sy 'c') <* (pmtSwap 1 3 :: Permutation N)
-- ProductSymbol['a'^2*'b'^2*'c']
--
--  __Note__
--
-- (1) 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").
--
-- (2) Possibly infinite complete sequences are represented by @[__x__]@.  
newtype ProductSymbol x = ProductSymbol (Product N (U x))
  deriving (ProductSymbol x -> ProductSymbol x -> Bool
forall x. Entity x => ProductSymbol x -> ProductSymbol x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProductSymbol x -> ProductSymbol x -> Bool
$c/= :: forall x. Entity x => ProductSymbol x -> ProductSymbol x -> Bool
== :: ProductSymbol x -> ProductSymbol x -> Bool
$c== :: forall x. Entity x => ProductSymbol x -> ProductSymbol x -> Bool
Eq,ProductSymbol x -> ProductSymbol x -> Bool
ProductSymbol x -> ProductSymbol x -> Ordering
ProductSymbol x -> ProductSymbol x -> ProductSymbol x
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {x}. (Entity x, Ord x) => Eq (ProductSymbol x)
forall x.
(Entity x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> Bool
forall x.
(Entity x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> Ordering
forall x.
(Entity x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> ProductSymbol x
min :: ProductSymbol x -> ProductSymbol x -> ProductSymbol x
$cmin :: forall x.
(Entity x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> ProductSymbol x
max :: ProductSymbol x -> ProductSymbol x -> ProductSymbol x
$cmax :: forall x.
(Entity x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> ProductSymbol x
>= :: ProductSymbol x -> ProductSymbol x -> Bool
$c>= :: forall x.
(Entity x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> Bool
> :: ProductSymbol x -> ProductSymbol x -> Bool
$c> :: forall x.
(Entity x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> Bool
<= :: ProductSymbol x -> ProductSymbol x -> Bool
$c<= :: forall x.
(Entity x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> Bool
< :: ProductSymbol x -> ProductSymbol x -> Bool
$c< :: forall x.
(Entity x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> Bool
compare :: ProductSymbol x -> ProductSymbol x -> Ordering
$ccompare :: forall x.
(Entity x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> Ordering
Ord,ProductSymbol x -> Statement
forall x. Entity x => ProductSymbol x -> Statement
forall a. (a -> Statement) -> Validable a
valid :: ProductSymbol x -> Statement
$cvalid :: forall x. Entity x => ProductSymbol x -> Statement
Validable,forall a. Show a -> Eq a -> Validable a -> Typeable a -> Entity a
forall x. Entity x => Eq (ProductSymbol x)
forall {x}. Entity x => Show (ProductSymbol x)
forall {x}. Entity x => Typeable (ProductSymbol x)
forall x. Entity x => Validable (ProductSymbol x)
Entity,Point (ProductSymbol x) -> ProductSymbol x
ProductSymbol x -> N -> ProductSymbol x
ProductSymbol x -> ProductSymbol x -> ProductSymbol x
forall {x}. Entity x => Oriented (ProductSymbol x)
forall x. Entity x => Point (ProductSymbol x) -> ProductSymbol x
forall x. Entity x => ProductSymbol x -> N -> ProductSymbol x
forall x.
Entity x =>
ProductSymbol x -> ProductSymbol x -> ProductSymbol x
forall c.
Oriented c
-> (Point c -> c)
-> (c -> c -> c)
-> (c -> N -> c)
-> Multiplicative c
npower :: ProductSymbol x -> N -> ProductSymbol x
$cnpower :: forall x. Entity x => ProductSymbol x -> N -> ProductSymbol x
* :: ProductSymbol x -> ProductSymbol x -> ProductSymbol x
$c* :: forall x.
Entity x =>
ProductSymbol x -> ProductSymbol x -> ProductSymbol x
one :: Point (ProductSymbol x) -> ProductSymbol x
$cone :: forall x. Entity x => Point (ProductSymbol x) -> ProductSymbol x
Multiplicative,forall a. Eq a => a -> ProductSymbol a -> Bool
forall a. Num a => ProductSymbol a -> a
forall a. Ord a => ProductSymbol a -> a
forall m. Monoid m => ProductSymbol m -> m
forall a. ProductSymbol a -> Bool
forall a. ProductSymbol a -> Int
forall a. ProductSymbol a -> [a]
forall a. (a -> a -> a) -> ProductSymbol a -> a
forall m a. Monoid m => (a -> m) -> ProductSymbol a -> m
forall b a. (b -> a -> b) -> b -> ProductSymbol a -> b
forall a b. (a -> b -> b) -> b -> ProductSymbol a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => ProductSymbol a -> a
$cproduct :: forall a. Num a => ProductSymbol a -> a
sum :: forall a. Num a => ProductSymbol a -> a
$csum :: forall a. Num a => ProductSymbol a -> a
minimum :: forall a. Ord a => ProductSymbol a -> a
$cminimum :: forall a. Ord a => ProductSymbol a -> a
maximum :: forall a. Ord a => ProductSymbol a -> a
$cmaximum :: forall a. Ord a => ProductSymbol a -> a
elem :: forall a. Eq a => a -> ProductSymbol a -> Bool
$celem :: forall a. Eq a => a -> ProductSymbol a -> Bool
length :: forall a. ProductSymbol a -> Int
$clength :: forall a. ProductSymbol a -> Int
null :: forall a. ProductSymbol a -> Bool
$cnull :: forall a. ProductSymbol a -> Bool
toList :: forall a. ProductSymbol a -> [a]
$ctoList :: forall a. ProductSymbol a -> [a]
foldl1 :: forall a. (a -> a -> a) -> ProductSymbol a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ProductSymbol a -> a
foldr1 :: forall a. (a -> a -> a) -> ProductSymbol a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> ProductSymbol a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> ProductSymbol a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ProductSymbol a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ProductSymbol a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ProductSymbol a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ProductSymbol a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ProductSymbol a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ProductSymbol a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> ProductSymbol a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> ProductSymbol a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ProductSymbol a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ProductSymbol a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ProductSymbol a -> m
fold :: forall m. Monoid m => ProductSymbol m -> m
$cfold :: forall m. Monoid m => ProductSymbol m -> m
Foldable,ProductSymbol x -> N
forall x. ProductSymbol x -> N
forall x. (x -> N) -> LengthN x
lengthN :: ProductSymbol x -> N
$clengthN :: forall x. ProductSymbol x -> N
LengthN)

-- | showing as a product of symbols.
psyShow :: Entity x => ProductSymbol x -> String
psyShow :: forall x. Entity x => ProductSymbol x -> String
psyShow (ProductSymbol Product N (U x)
xs) = forall {a} {a}. (Eq a, Num a, Show a, Show a) => [(a, a)] -> String
shws forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(U x
p,N
n) -> (x
p,N
n)) forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r a. Word r a -> [(a, r)]
fromWord forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r a. (Integral r, Oriented a) => Product r a -> Word r a
prwrd Product N (U x)
xs where
  shws :: [(a, a)] -> String
shws [(a, a)]
ps = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a. a -> [a] -> [a]
tween String
"*" forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (Eq a, Num a, Show a, Show a) => (a, a) -> String
shw [(a, a)]
ps
  shw :: (a, a) -> String
shw (a
p,a
1) = forall a. Show a => a -> String
show a
p
  shw (a
p,a
n) = forall a. Show a => a -> String
show a
p forall a. [a] -> [a] -> [a]
++ String
"^" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
n


instance Entity x => Show (ProductSymbol x) where
  show :: ProductSymbol x -> String
show ProductSymbol x
p = String
"ProductSymbol[" forall a. [a] -> [a] -> [a]
++ forall x. Entity x => ProductSymbol x -> String
psyShow ProductSymbol x
p forall a. [a] -> [a] -> [a]
++ String
"]"

instance Entity x => Oriented (ProductSymbol x) where
  type Point (ProductSymbol x) = ()
  orientation :: ProductSymbol x -> Orientation (Point (ProductSymbol x))
orientation = forall b a. b -> a -> b
const (()forall p. p -> p -> Orientation p
:>())

instance Entity x => Exponential (ProductSymbol x) where
  type Exponent (ProductSymbol x) = N
  ProductSymbol Product N (U x)
xs ^ :: ProductSymbol x -> Exponent (ProductSymbol x) -> ProductSymbol x
^ Exponent (ProductSymbol x)
n = forall x. Product N (U x) -> ProductSymbol x
ProductSymbol (Product N (U x)
xs forall f. Exponential f => f -> Exponent f -> f
^ Exponent (ProductSymbol x)
n)

instance Exposable (ProductSymbol x) where
  type Form (ProductSymbol x) = ProductForm N (U x)
  form :: ProductSymbol x -> Form (ProductSymbol x)
form (ProductSymbol Product N (U x)
xs) = forall x. Exposable x => x -> Form x
form Product N (U x)
xs
  
instance Entity x => Constructable (ProductSymbol x) where
  make :: Form (ProductSymbol x) -> ProductSymbol x
make Form (ProductSymbol x)
p = forall x. Product N (U x) -> ProductSymbol x
ProductSymbol forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall x. Constructable x => Form x -> x
make Form (ProductSymbol x)
p

--------------------------------------------------------------------------------
-- nProxy -

-- | proxy for 'N'.
nProxy :: Proxy N
nProxy :: Proxy N
nProxy = forall {k} (t :: k). Proxy t
Proxy

--------------------------------------------------------------------------------
-- psyxs -

-- | the indexed listing of the symbols.
psyxs :: ProductSymbol x -> [(x,N)]
psyxs :: forall x. ProductSymbol x -> [(x, N)]
psyxs = forall (s :: * -> *) i x (p :: * -> *).
Sequence s i x =>
p i -> s x -> [(x, i)]
list Proxy N
nProxy

--------------------------------------------------------------------------------
-- psywrd -

-- | the underlying word.
psywrd :: Entity x => ProductSymbol x -> Word N x
psywrd :: forall x. Entity x => ProductSymbol x -> Word N x
psywrd (ProductSymbol Product N (U x)
p) = forall r a. [(a, r)] -> Word r a
Word forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(U x
x,N
n) -> (x
x,N
n)) forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r a. Word r a -> [(a, r)]
fromWord forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r a. (Integral r, Oriented a) => Product r a -> Word r a
prwrd Product N (U x)
p

--------------------------------------------------------------------------------
-- wrdpsy -

-- | from word.
wrdpsy :: Entity x => Word N x -> ProductSymbol x
wrdpsy :: forall x. Entity x => Word N x -> ProductSymbol x
wrdpsy (Word [(x, N)]
ws) = forall x. Constructable x => Form x -> x
make forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r a. Semiring r => Point a -> Word r a -> ProductForm r a
wrdprf () forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r a. [(a, r)] -> Word r a
Word forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(x
x,N
n) -> (forall x. x -> U x
U x
x,N
n)) forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ [(x, N)]
ws
--------------------------------------------------------------------------------
-- productSymbol -

-- | the induced product of symbols.
productSymbol :: Entity x => [x] -> ProductSymbol x
productSymbol :: forall x. Entity x => [x] -> ProductSymbol x
productSymbol [x]
xs = forall x. Product N (U x) -> ProductSymbol x
ProductSymbol forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall x. Constructable x => Form x -> x
make forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall r a. ProductForm r a -> ProductForm r a -> ProductForm r a
(:*) (forall r a. Point a -> ProductForm r a
One ()) forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall r a. a -> ProductForm r a
P forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. forall x. x -> U x
U) [x]
xs

--------------------------------------------------------------------------------
-- csqSqc -

-- | the induce product of symbols given by a partial map and a support set.
csqSqc :: Entity x => (i -> Maybe x) -> Set i -> ProductSymbol x
csqSqc :: forall x i. Entity x => (i -> Maybe x) -> Set i -> ProductSymbol x
csqSqc i -> Maybe x
mx (Set [i]
is)
  = forall x. Entity x => [x] -> ProductSymbol x
productSymbol
  forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. HasCallStack => Maybe a -> a
fromJust
  forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall a. Maybe a -> Bool
isJust
  forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map i -> Maybe x
mx [i]
is

--------------------------------------------------------------------------------
-- ProductSymbol - Sequence -

instance Sequence ProductSymbol N x where
  list :: forall (p :: * -> *). p N -> ProductSymbol x -> [(x, N)]
list p N
f (ProductSymbol Product N (U x)
p) = forall a b. (a -> b) -> [a] -> [b]
map (\(U x
x,N
i) -> (x
x,N
i)) forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall (s :: * -> *) i x (p :: * -> *).
Sequence s i x =>
p i -> s x -> [(x, i)]
list p N
f Product N (U x)
p 
  ProductSymbol Product N (U x)
p ?? :: ProductSymbol x -> N -> Maybe x
?? N
i = forall (h :: * -> * -> *) (f :: * -> *) a b.
Applicative1 h f =>
h a b -> f a -> f b
amap1 forall x. U x -> x
fromU (Product N (U x)
p forall (s :: * -> *) i x. Sequence s i x => s x -> i -> Maybe x
?? N
i)

instance Entity x => ConstructableSequence ProductSymbol N x where
  sequence :: (N -> Maybe x) -> Set N -> ProductSymbol x
sequence = forall x i. Entity x => (i -> Maybe x) -> Set i -> ProductSymbol x
csqSqc
  
--------------------------------------------------------------------------------
-- sy -

-- | 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']
sy :: Entity x => x -> ProductSymbol x
sy :: forall x. Entity x => x -> ProductSymbol x
sy x
x = forall x. Entity x => [x] -> ProductSymbol x
productSymbol [x
x]

--------------------------------------------------------------------------------
-- psyLength -

-- | the length of a complete sequence.
psyLength :: ProductSymbol x -> N
psyLength :: forall x. ProductSymbol x -> N
psyLength (ProductSymbol Product N (U x)
xs) = forall a. Product N a -> N
prLength Product N (U x)
xs


--------------------------------------------------------------------------------
-- psyFactor -

-- | the symbol for the given index.
psyFactor :: ProductSymbol x -> N -> x
psyFactor :: forall x. ProductSymbol x -> N -> x
psyFactor (ProductSymbol Product N (U x)
xs) = (\(U x
x) -> x
x) forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. forall a. Product N a -> N -> a
prFactor Product N (U x)
xs

--------------------------------------------------------------------------------
-- psyMap -

-- | mapping free products of symbols. 
psyMap :: Entity y => (x -> y) -> ProductSymbol x -> ProductSymbol y
psyMap :: forall y x.
Entity y =>
(x -> y) -> ProductSymbol x -> ProductSymbol y
psyMap x -> y
f (ProductSymbol Product N (U x)
xs) = forall x. Product N (U x) -> ProductSymbol x
ProductSymbol forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall y r x.
(Singleton (Point y), Oriented y, Integral r) =>
(x -> y) -> Product r x -> Product r y
prdMapTotal (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
f) Product N (U x)
xs 


--------------------------------------------------------------------------------
-- psyJoin -

-- | joining complete sequences.
psyJoin :: Entity x => ProductSymbol (ProductSymbol x) -> ProductSymbol x
psyJoin :: forall x.
Entity x =>
ProductSymbol (ProductSymbol x) -> ProductSymbol x
psyJoin (ProductSymbol Product N (U (ProductSymbol x))
xxs) = forall x. Product N (U x) -> ProductSymbol x
ProductSymbol forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall x. Constructable x => Form x -> x
make forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall x y. Exposable x => (Form x -> y) -> x -> y
restrict (forall y x r.
Singleton (Point y) =>
(x -> ProductForm r y) -> ProductForm r x -> ProductForm r y
prfMapTotal forall {x}. Exposable x => U x -> Form x
f) Product N (U (ProductSymbol x))
xxs where
  f :: U x -> Form x
f (U x
p) = forall x y. Exposable x => (Form x -> y) -> x -> y
restrict forall x. x -> x
id x
p


--------------------------------------------------------------------------------
-- xProductSymbol -

-- | random variable of complete sequences with the given maximal length.
xProductSymbol :: Entity x => N -> X x -> X (ProductSymbol x)
xProductSymbol :: forall x. Entity x => N -> X x -> X (ProductSymbol x)
xProductSymbol N
n X x
xx = do
  N
n' <- N -> N -> X N
xNB N
0 N
n
  [x]
xs <- forall x. N -> X x -> X [x]
xTakeN N
n' X x
xx
  forall (m :: * -> *) a. Monad m => a -> m a
return forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall x. Entity x => [x] -> ProductSymbol x
productSymbol [x]
xs