{-# 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
  
    -- * X
  , xProductSymbol
  ) where

import Control.Monad

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

import OAlg.Prelude

import OAlg.Data.Canonical
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

--------------------------------------------------------------------------------
-- 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
(ProductSymbol x -> ProductSymbol x -> Bool)
-> (ProductSymbol x -> ProductSymbol x -> Bool)
-> Eq (ProductSymbol x)
forall x.
(Show x, Validable x, Eq x, Typeable x) =>
ProductSymbol x -> ProductSymbol x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall x.
(Show x, Validable x, Eq x, Typeable x) =>
ProductSymbol x -> ProductSymbol x -> Bool
== :: ProductSymbol x -> ProductSymbol x -> Bool
$c/= :: forall x.
(Show x, Validable x, Eq x, Typeable x) =>
ProductSymbol x -> ProductSymbol x -> Bool
/= :: ProductSymbol x -> ProductSymbol x -> Bool
Eq,Eq (ProductSymbol x)
Eq (ProductSymbol x) =>
(ProductSymbol x -> ProductSymbol x -> Ordering)
-> (ProductSymbol x -> ProductSymbol x -> Bool)
-> (ProductSymbol x -> ProductSymbol x -> Bool)
-> (ProductSymbol x -> ProductSymbol x -> Bool)
-> (ProductSymbol x -> ProductSymbol x -> Bool)
-> (ProductSymbol x -> ProductSymbol x -> ProductSymbol x)
-> (ProductSymbol x -> ProductSymbol x -> ProductSymbol x)
-> Ord (ProductSymbol x)
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.
(Show x, Validable x, Typeable x, Ord x) =>
Eq (ProductSymbol x)
forall x.
(Show x, Validable x, Typeable x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> Bool
forall x.
(Show x, Validable x, Typeable x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> Ordering
forall x.
(Show x, Validable x, Typeable x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> ProductSymbol x
$ccompare :: forall x.
(Show x, Validable x, Typeable x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> Ordering
compare :: ProductSymbol x -> ProductSymbol x -> Ordering
$c< :: forall x.
(Show x, Validable x, Typeable x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> Bool
< :: ProductSymbol x -> ProductSymbol x -> Bool
$c<= :: forall x.
(Show x, Validable x, Typeable x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> Bool
<= :: ProductSymbol x -> ProductSymbol x -> Bool
$c> :: forall x.
(Show x, Validable x, Typeable x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> Bool
> :: ProductSymbol x -> ProductSymbol x -> Bool
$c>= :: forall x.
(Show x, Validable x, Typeable x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> Bool
>= :: ProductSymbol x -> ProductSymbol x -> Bool
$cmax :: forall x.
(Show x, Validable x, Typeable x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> ProductSymbol x
max :: ProductSymbol x -> ProductSymbol x -> ProductSymbol x
$cmin :: forall x.
(Show x, Validable x, Typeable x, Ord x) =>
ProductSymbol x -> ProductSymbol x -> ProductSymbol x
min :: ProductSymbol x -> ProductSymbol x -> ProductSymbol x
Ord,ProductSymbol x -> Statement
(ProductSymbol x -> Statement) -> Validable (ProductSymbol x)
forall x.
(Show x, Validable x, Eq x, Typeable x) =>
ProductSymbol x -> Statement
forall a. (a -> Statement) -> Validable a
$cvalid :: forall x.
(Show x, Validable x, Eq x, Typeable x) =>
ProductSymbol x -> Statement
valid :: ProductSymbol x -> Statement
Validable,Oriented (ProductSymbol x)
Point (ProductSymbol x) -> ProductSymbol x
Oriented (ProductSymbol x) =>
(Point (ProductSymbol x) -> ProductSymbol x)
-> (ProductSymbol x -> ProductSymbol x -> ProductSymbol x)
-> (ProductSymbol x -> N -> ProductSymbol x)
-> Multiplicative (ProductSymbol x)
ProductSymbol x -> N -> ProductSymbol x
ProductSymbol x -> ProductSymbol x -> ProductSymbol x
forall x.
(Show x, Validable x, Eq x, Typeable x) =>
Oriented (ProductSymbol x)
forall x.
(Show x, Validable x, Eq x, Typeable x) =>
Point (ProductSymbol x) -> ProductSymbol x
forall x.
(Show x, Validable x, Eq x, Typeable x) =>
ProductSymbol x -> N -> ProductSymbol x
forall x.
(Show x, Validable x, Eq x, Typeable x) =>
ProductSymbol x -> ProductSymbol x -> ProductSymbol x
forall c.
Oriented c =>
(Point c -> c)
-> (c -> c -> c) -> (c -> N -> c) -> Multiplicative c
$cone :: forall x.
(Show x, Validable x, Eq x, Typeable x) =>
Point (ProductSymbol x) -> ProductSymbol x
one :: Point (ProductSymbol x) -> ProductSymbol x
$c* :: forall x.
(Show x, Validable x, Eq x, Typeable x) =>
ProductSymbol x -> ProductSymbol x -> ProductSymbol x
* :: ProductSymbol x -> ProductSymbol x -> ProductSymbol x
$cnpower :: forall x.
(Show x, Validable x, Eq x, Typeable x) =>
ProductSymbol x -> N -> ProductSymbol x
npower :: ProductSymbol x -> N -> ProductSymbol x
Multiplicative,(forall m. Monoid m => ProductSymbol m -> m)
-> (forall m a. Monoid m => (a -> m) -> ProductSymbol a -> m)
-> (forall m a. Monoid m => (a -> m) -> ProductSymbol a -> m)
-> (forall a b. (a -> b -> b) -> b -> ProductSymbol a -> b)
-> (forall a b. (a -> b -> b) -> b -> ProductSymbol a -> b)
-> (forall b a. (b -> a -> b) -> b -> ProductSymbol a -> b)
-> (forall b a. (b -> a -> b) -> b -> ProductSymbol a -> b)
-> (forall a. (a -> a -> a) -> ProductSymbol a -> a)
-> (forall a. (a -> a -> a) -> ProductSymbol a -> a)
-> (forall a. ProductSymbol a -> [a])
-> (forall a. ProductSymbol a -> Bool)
-> (forall a. ProductSymbol a -> Int)
-> (forall a. Eq a => a -> ProductSymbol a -> Bool)
-> (forall a. Ord a => ProductSymbol a -> a)
-> (forall a. Ord a => ProductSymbol a -> a)
-> (forall a. Num a => ProductSymbol a -> a)
-> (forall a. Num a => ProductSymbol a -> a)
-> Foldable ProductSymbol
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
$cfold :: forall m. Monoid m => ProductSymbol m -> m
fold :: forall m. Monoid m => ProductSymbol m -> 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
foldMap' :: forall m a. Monoid m => (a -> m) -> ProductSymbol a -> m
$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
foldr' :: forall a b. (a -> b -> 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
foldl' :: forall b a. (b -> a -> b) -> b -> ProductSymbol a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ProductSymbol a -> a
foldr1 :: forall a. (a -> a -> a) -> ProductSymbol a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ProductSymbol a -> a
foldl1 :: forall a. (a -> a -> a) -> ProductSymbol a -> a
$ctoList :: forall a. ProductSymbol a -> [a]
toList :: forall a. ProductSymbol a -> [a]
$cnull :: forall a. ProductSymbol a -> Bool
null :: forall a. ProductSymbol a -> Bool
$clength :: forall a. ProductSymbol a -> Int
length :: forall a. ProductSymbol a -> Int
$celem :: forall a. Eq a => a -> ProductSymbol a -> Bool
elem :: forall a. Eq a => a -> ProductSymbol a -> Bool
$cmaximum :: forall a. Ord a => ProductSymbol a -> a
maximum :: forall a. Ord a => ProductSymbol a -> a
$cminimum :: forall a. Ord a => ProductSymbol a -> a
minimum :: forall a. Ord a => ProductSymbol a -> a
$csum :: forall a. Num a => ProductSymbol a -> a
sum :: forall a. Num a => ProductSymbol a -> a
$cproduct :: forall a. Num a => ProductSymbol a -> a
product :: forall a. Num a => ProductSymbol a -> a
Foldable,ProductSymbol x -> N
(ProductSymbol x -> N) -> LengthN (ProductSymbol x)
forall x. ProductSymbol x -> N
forall x. (x -> N) -> LengthN x
$clengthN :: forall x. ProductSymbol x -> N
lengthN :: 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) = [(x, N)] -> String
forall {a} {a}. (Eq a, Num a, Show a, Show a) => [(a, a)] -> String
shws ([(x, N)] -> String) -> [(x, N)] -> String
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ ((U x, N) -> (x, N)) -> [(U x, N)] -> [(x, N)]
forall a b. (a -> b) -> [a] -> [b]
map (\(U x
p,N
n) -> (x
p,N
n)) ([(U x, N)] -> [(x, N)]) -> [(U x, N)] -> [(x, N)]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ Word N (U x) -> [(U x, N)]
forall r a. Word r a -> [(a, r)]
fromWord (Word N (U x) -> [(U x, N)]) -> Word N (U x) -> [(U x, N)]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ Product N (U x) -> Word N (U x)
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 = [String] -> String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([String] -> String) -> [String] -> String
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
tween String
"*" ([String] -> [String]) -> [String] -> [String]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ ((a, a) -> String) -> [(a, a)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> String
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) = a -> String
forall a. Show a => a -> String
show a
p
  shw (a
p,a
n) = a -> String
forall a. Show a => a -> String
show a
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"^" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
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[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ProductSymbol x -> String
forall x. Entity x => ProductSymbol x -> String
psyShow ProductSymbol x
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"

type instance Point (ProductSymbol x) = ()
instance ShowPoint (ProductSymbol x)
instance EqPoint (ProductSymbol x)
instance ValidablePoint (ProductSymbol x)
instance TypeablePoint (ProductSymbol x)

instance Entity x => Oriented (ProductSymbol x) where
  orientation :: ProductSymbol x -> Orientation (Point (ProductSymbol x))
orientation = Orientation () -> ProductSymbol x -> Orientation ()
forall b a. b -> a -> b
const (()() -> () -> Orientation ()
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 = Product N (U x) -> ProductSymbol x
forall x. Product N (U x) -> ProductSymbol x
ProductSymbol (Product N (U x)
xs Product N (U x) -> Exponent (Product N (U x)) -> Product N (U x)
forall f. Exponential f => f -> Exponent f -> f
^ Exponent (Product N (U x))
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) = Product N (U x) -> Form (Product N (U x))
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 = Product N (U x) -> ProductSymbol x
forall x. Product N (U x) -> ProductSymbol x
ProductSymbol (Product N (U x) -> ProductSymbol x)
-> Product N (U x) -> ProductSymbol x
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ Form (Product N (U x)) -> Product N (U x)
forall x. Constructable x => Form x -> x
make Form (Product N (U x))
Form (ProductSymbol x)
p

--------------------------------------------------------------------------------
-- Canonical -

instance Entity x => Projectible (ProductSymbol x) [x] where
  prj :: [x] -> ProductSymbol x
prj = Product N (U x) -> ProductSymbol x
forall x. Product N (U x) -> ProductSymbol x
ProductSymbol (Product N (U x) -> ProductSymbol x)
-> ([x] -> Product N (U x)) -> [x] -> ProductSymbol x
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. Word N (U x) -> Product N (U x)
forall a b. Projectible a b => b -> a
prj (Word N (U x) -> Product N (U x))
-> ([x] -> Word N (U x)) -> [x] -> Product N (U x)
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. [(U x, N)] -> Word N (U x)
forall r a. [(a, r)] -> Word r a
Word ([(U x, N)] -> Word N (U x))
-> ([x] -> [(U x, N)]) -> [x] -> Word N (U x)
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. (x -> (U x, N)) -> [x] -> [(U x, N)]
forall (h :: * -> * -> *) (f :: * -> *) x y.
Applicative1 h f =>
h x y -> f x -> f y
amap1 (\x
x -> (x -> U x
forall x. x -> U x
U x
x,N
1 :: N))

instance Entity x => Projectible (ProductSymbol x) (Word N x) where
  prj :: Word N x -> ProductSymbol x
prj = Product N (U x) -> ProductSymbol x
forall x. Product N (U x) -> ProductSymbol x
ProductSymbol (Product N (U x) -> ProductSymbol x)
-> (Word N x -> Product N (U x)) -> Word N x -> ProductSymbol x
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. Word N (U x) -> Product N (U x)
forall a b. Projectible a b => b -> a
prj  (Word N (U x) -> Product N (U x))
-> (Word N x -> Word N (U x)) -> Word N x -> Product N (U x)
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. (x -> U x) -> Word N x -> Word N (U x)
forall (h :: * -> * -> *) (f :: * -> *) x y.
Applicative1 h f =>
h x y -> f x -> f y
amap1 x -> U x
forall x. x -> U x
U

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

-- | proxy for 'N'.
nProxy :: Proxy N
nProxy :: Proxy N
nProxy = Proxy N
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 = Proxy N -> ProductSymbol x -> [(x, N)]
forall (p :: * -> *). p N -> ProductSymbol x -> [(x, N)]
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) = [(x, N)] -> Word N x
forall r a. [(a, r)] -> Word r a
Word ([(x, N)] -> Word N x) -> [(x, N)] -> Word N x
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ ((U x, N) -> (x, N)) -> [(U x, N)] -> [(x, N)]
forall a b. (a -> b) -> [a] -> [b]
map (\(U x
x,N
n) -> (x
x,N
n)) ([(U x, N)] -> [(x, N)]) -> [(U x, N)] -> [(x, N)]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ Word N (U x) -> [(U x, N)]
forall r a. Word r a -> [(a, r)]
fromWord (Word N (U x) -> [(U x, N)]) -> Word N (U x) -> [(U x, N)]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ Product N (U x) -> Word N (U x)
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) = Form (ProductSymbol x) -> ProductSymbol x
ProductForm N (U x) -> ProductSymbol x
forall x. Constructable x => Form x -> x
make (ProductForm N (U x) -> ProductSymbol x)
-> ProductForm N (U x) -> ProductSymbol x
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ Point (U x) -> Word N (U x) -> ProductForm N (U x)
forall r a. Semiring r => Point a -> Word r a -> ProductForm r a
wrdprf () (Word N (U x) -> ProductForm N (U x))
-> Word N (U x) -> ProductForm N (U x)
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ [(U x, N)] -> Word N (U x)
forall r a. [(a, r)] -> Word r a
Word ([(U x, N)] -> Word N (U x)) -> [(U x, N)] -> Word N (U x)
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ ((x, N) -> (U x, N)) -> [(x, N)] -> [(U x, N)]
forall a b. (a -> b) -> [a] -> [b]
map (\(x
x,N
n) -> (x -> U x
forall x. x -> U x
U x
x,N
n)) ([(x, N)] -> [(U x, N)]) -> [(x, N)] -> [(U x, N)]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ [(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 = Product N (U x) -> ProductSymbol x
forall x. Product N (U x) -> ProductSymbol x
ProductSymbol (Product N (U x) -> ProductSymbol x)
-> Product N (U x) -> ProductSymbol x
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ Form (Product N (U x)) -> Product N (U x)
ProductForm N (U x) -> Product N (U x)
forall x. Constructable x => Form x -> x
make (ProductForm N (U x) -> Product N (U x))
-> ProductForm N (U x) -> Product N (U x)
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ (ProductForm N (U x) -> ProductForm N (U x) -> ProductForm N (U x))
-> ProductForm N (U x)
-> [ProductForm N (U x)]
-> ProductForm N (U x)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ProductForm N (U x) -> ProductForm N (U x) -> ProductForm N (U x)
forall r a. ProductForm r a -> ProductForm r a -> ProductForm r a
(:*) (Point (U x) -> ProductForm N (U x)
forall r a. Point a -> ProductForm r a
One ()) ([ProductForm N (U x)] -> ProductForm N (U x))
-> [ProductForm N (U x)] -> ProductForm N (U x)
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ (x -> ProductForm N (U x)) -> [x] -> [ProductForm N (U x)]
forall a b. (a -> b) -> [a] -> [b]
map (U x -> ProductForm N (U x)
forall r a. a -> ProductForm r a
P (U x -> ProductForm N (U x))
-> (x -> U x) -> x -> ProductForm N (U x)
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. x -> U x
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)
  = [x] -> ProductSymbol x
forall x. Entity x => [x] -> ProductSymbol x
productSymbol
  ([x] -> ProductSymbol x) -> [x] -> ProductSymbol x
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ (Maybe x -> x) -> [Maybe x] -> [x]
forall a b. (a -> b) -> [a] -> [b]
map Maybe x -> x
forall a. HasCallStack => Maybe a -> a
fromJust
  ([Maybe x] -> [x]) -> [Maybe x] -> [x]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ (Maybe x -> Bool) -> [Maybe x] -> [Maybe x]
forall a. (a -> Bool) -> [a] -> [a]
filter Maybe x -> Bool
forall a. Maybe a -> Bool
isJust
  ([Maybe x] -> [Maybe x]) -> [Maybe x] -> [Maybe x]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ (i -> Maybe x) -> [i] -> [Maybe x]
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) = ((U x, N) -> (x, N)) -> [(U x, N)] -> [(x, N)]
forall a b. (a -> b) -> [a] -> [b]
map (\(U x
x,N
i) -> (x
x,N
i)) ([(U x, N)] -> [(x, N)]) -> [(U x, N)] -> [(x, N)]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ p N -> Product N (U x) -> [(U x, N)]
forall (p :: * -> *). p N -> Product N (U x) -> [(U x, N)]
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 = (U x -> x) -> Maybe (U x) -> Maybe x
forall (h :: * -> * -> *) (f :: * -> *) x y.
Applicative1 h f =>
h x y -> f x -> f y
amap1 U x -> x
forall x. U x -> x
fromU (Product N (U x)
p Product N (U x) -> N -> Maybe (U x)
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 = (N -> Maybe x) -> Set N -> ProductSymbol x
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 = [x] -> ProductSymbol 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) = Product N (U x) -> N
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) (U x -> x) -> (N -> U x) -> N -> x
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. Product N (U x) -> N -> U x
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) = Product N (U y) -> ProductSymbol y
forall x. Product N (U x) -> ProductSymbol x
ProductSymbol (Product N (U y) -> ProductSymbol y)
-> Product N (U y) -> ProductSymbol y
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ (U x -> U y) -> Product N (U x) -> Product N (U y)
forall y r x.
(Singleton (Point y), Oriented y, Integral r) =>
(x -> y) -> Product r x -> Product r y
prdMapTotal ((x -> y) -> U x -> U y
forall a b. (a -> b) -> U a -> U b
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) = Product N (U x) -> ProductSymbol x
forall x. Product N (U x) -> ProductSymbol x
ProductSymbol (Product N (U x) -> ProductSymbol x)
-> Product N (U x) -> ProductSymbol x
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ Form (Product N (U x)) -> Product N (U x)
ProductForm N (U x) -> Product N (U x)
forall x. Constructable x => Form x -> x
make (ProductForm N (U x) -> Product N (U x))
-> ProductForm N (U x) -> Product N (U x)
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ (Form (Product N (U (ProductSymbol x))) -> ProductForm N (U x))
-> Product N (U (ProductSymbol x)) -> ProductForm N (U x)
forall x y. Exposable x => (Form x -> y) -> x -> y
restrict ((U (ProductSymbol x) -> ProductForm N (U x))
-> ProductForm N (U (ProductSymbol x)) -> ProductForm N (U x)
forall y x r.
Singleton (Point y) =>
(x -> ProductForm r y) -> ProductForm r x -> ProductForm r y
prfMapTotal U (ProductSymbol x) -> Form (ProductSymbol x)
U (ProductSymbol x) -> ProductForm N (U x)
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) = (Form x -> Form x) -> x -> Form x
forall x y. Exposable x => (Form x -> y) -> x -> y
restrict Form x -> Form x
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 <- N -> X x -> X [x]
forall x. N -> X x -> X [x]
xTakeN N
n' X x
xx
  ProductSymbol x -> X (ProductSymbol x)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProductSymbol x -> X (ProductSymbol x))
-> ProductSymbol x -> X (ProductSymbol x)
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ [x] -> ProductSymbol x
forall x. Entity x => [x] -> ProductSymbol x
productSymbol [x]
xs