> {-# OPTIONS_HADDOCK show-extensions #-}
> {-|
> Module    : LTK.Algebra
> Copyright : (c) 2021-2023 Dakotah Lambert
> License   : MIT

> This module centralizes definitions of some commonly used
> algebraic properties.
>
> @since 1.0
> -}

> module LTK.Algebra
>     ( -- *Type
>       SynMon
>       -- *Tests
>     , isCommutative
>       -- *Generated Submonoids and Subsemigroups
>     , me
>     , emee
>     , ese
>       -- * Other generation
>     , syntacticOrder
>     , emblock
>       -- *Powers
>     , idempotents
>     , omega
>     ) where

> import Data.Set (Set)
> import qualified Data.Set as Set

> import LTK.FSA

> -- | A simpler way to denote syntactic monoids in type signatures.
> type SynMon n e = FSA ([Maybe n],[Symbol e]) e


Generated Submonoids
====================

For a monid M and idempotent e, Me is the set generated by
    {m : e is in the two-sided ideal of m}.

The class MeV, for some variety V, is the set of all monoids M
where for all idempotents e, e*Me*e is in V.

> -- |For a given idempotent \(e\), return the set generated by
> -- \(\{m : (\exists u,v)[umv=e]\}\).
> me :: (Ord n, Ord e) => FSA (n,[Symbol e]) e
>    -> State (n, [Symbol e]) -> Set (State (n, [Symbol e]))
> me :: forall n e.
(Ord n, Ord e) =>
FSA (n, [Symbol e]) e
-> State (n, [Symbol e]) -> Set (State (n, [Symbol e]))
me FSA (n, [Symbol e]) e
monoid State (n, [Symbol e])
e = FSA (n, [Symbol e]) e -> Set (State (n, [Symbol e]))
forall e n. (Ord e, Ord n) => FSA n e -> Set (State n)
states (FSA (n, [Symbol e]) e -> Set (State (n, [Symbol e])))
-> (FSA (n, [Symbol e]) e -> FSA (n, [Symbol e]) e)
-> FSA (n, [Symbol e]) e
-> Set (State (n, [Symbol e]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA (n, [Symbol e]) e -> FSA (n, [Symbol e]) e
forall e n. (Ord e, Ord n) => FSA n e -> FSA n e
trimUnreachables
>               (FSA (n, [Symbol e]) e -> Set (State (n, [Symbol e])))
-> FSA (n, [Symbol e]) e -> Set (State (n, [Symbol e]))
forall a b. (a -> b) -> a -> b
$ Set e -> FSA (n, [Symbol e]) e -> FSA (n, [Symbol e]) e
forall a b. (Ord a, Ord b) => Set b -> FSA a b -> FSA a b
contractAlphabetTo Set e
syms FSA (n, [Symbol e]) e
monoid
>     where syms :: Set e
syms = (e -> Bool) -> Set e -> Set e
forall (s :: * -> *) a.
(Collapsible s, Container (s a) a) =>
(a -> Bool) -> s a -> s a
keep (State (n, [Symbol e]) -> Set (State (n, [Symbol e])) -> Bool
forall c a. (Container c a, Eq a) => a -> c -> Bool
contains State (n, [Symbol e])
e (Set (State (n, [Symbol e])) -> Bool)
-> (e -> Set (State (n, [Symbol e]))) -> e -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Set (State (n, [Symbol e]))) -> Set (State (n, [Symbol e]))
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
>                        (Set (Set (State (n, [Symbol e]))) -> Set (State (n, [Symbol e])))
-> (e -> Set (Set (State (n, [Symbol e]))))
-> e
-> Set (State (n, [Symbol e]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State (n, [Symbol e]) -> Set (State (n, [Symbol e])))
-> Set (State (n, [Symbol e])) -> Set (Set (State (n, [Symbol e])))
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (FSA (n, [Symbol e]) e
-> State (n, [Symbol e]) -> Set (State (n, [Symbol e]))
forall n e.
(Ord n, Ord e) =>
FSA (n, [Symbol e]) e
-> State (n, [Symbol e]) -> Set (State (n, [Symbol e]))
primitiveIdeal2 FSA (n, [Symbol e]) e
monoid) (Set (State (n, [Symbol e])) -> Set (Set (State (n, [Symbol e]))))
-> (e -> Set (State (n, [Symbol e])))
-> e
-> Set (Set (State (n, [Symbol e])))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Set (State (n, [Symbol e]))
s)
>                  (Set e -> Set e) -> Set e -> Set e
forall a b. (a -> b) -> a -> b
$ FSA (n, [Symbol e]) e -> Set e
forall e. FSA (n, [Symbol e]) e -> Set e
forall (g :: * -> *) e. HasAlphabet g => g e -> Set e
alphabet FSA (n, [Symbol e]) e
monoid
>           s :: e -> Set (State (n, [Symbol e]))
s e
x = Set (Set (State (n, [Symbol e]))) -> Set (State (n, [Symbol e]))
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
>                 (Set (Set (State (n, [Symbol e]))) -> Set (State (n, [Symbol e])))
-> (Set (State (n, [Symbol e]))
    -> Set (Set (State (n, [Symbol e]))))
-> Set (State (n, [Symbol e]))
-> Set (State (n, [Symbol e]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State (n, [Symbol e]) -> Set (State (n, [Symbol e])))
-> Set (State (n, [Symbol e])) -> Set (Set (State (n, [Symbol e])))
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (FSA (n, [Symbol e]) e
-> [Symbol e]
-> State (n, [Symbol e])
-> Set (State (n, [Symbol e]))
forall n e.
(Ord n, Ord e) =>
FSA n e -> [Symbol e] -> State n -> Set (State n)
follow FSA (n, [Symbol e]) e
monoid [e -> Symbol e
forall e. e -> Symbol e
Symbol e
x])
>                 (Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e])))
-> Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e]))
forall a b. (a -> b) -> a -> b
$ FSA (n, [Symbol e]) e -> Set (State (n, [Symbol e]))
forall n e. FSA n e -> Set (State n)
initials FSA (n, [Symbol e]) e
monoid

emee is e*Me*e: first follow the label of e from all the states,
then take the resulting labels and follow those from e.

> -- |For a given idempotent \(e\), return the set @me monoid e@
> -- multiplied on the left and right by \(e\).
> emee :: (Ord n, Ord e) => FSA (n, [Symbol e]) e
>      -> State (n, [Symbol e]) -> Set (State (n, [Symbol e]))
> emee :: forall n e.
(Ord n, Ord e) =>
FSA (n, [Symbol e]) e
-> State (n, [Symbol e]) -> Set (State (n, [Symbol e]))
emee FSA (n, [Symbol e]) e
monoid State (n, [Symbol e])
e = (State (n, [Symbol e])
 -> Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e])))
-> Set (State (n, [Symbol e]))
-> Set (State (n, [Symbol e]))
-> Set (State (n, [Symbol e]))
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (Set (State (n, [Symbol e]))
-> Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e]))
forall c a. Container c a => c -> c -> c
union (Set (State (n, [Symbol e]))
 -> Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e])))
-> (State (n, [Symbol e]) -> Set (State (n, [Symbol e])))
-> State (n, [Symbol e])
-> Set (State (n, [Symbol e]))
-> Set (State (n, [Symbol e]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Symbol e]
 -> State (n, [Symbol e]) -> Set (State (n, [Symbol e])))
-> State (n, [Symbol e])
-> [Symbol e]
-> Set (State (n, [Symbol e]))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FSA (n, [Symbol e]) e
-> [Symbol e]
-> State (n, [Symbol e])
-> Set (State (n, [Symbol e]))
forall n e.
(Ord n, Ord e) =>
FSA n e -> [Symbol e] -> State n -> Set (State n)
follow FSA (n, [Symbol e]) e
monoid) State (n, [Symbol e])
e ([Symbol e] -> Set (State (n, [Symbol e])))
-> (State (n, [Symbol e]) -> [Symbol e])
-> State (n, [Symbol e])
-> Set (State (n, [Symbol e]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State (n, [Symbol e]) -> [Symbol e]
forall {a} {c}. State (a, c) -> c
s) Set (State (n, [Symbol e]))
forall c a. Container c a => c
empty
>                 (Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e])))
-> (Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e])))
-> Set (State (n, [Symbol e]))
-> Set (State (n, [Symbol e]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State (n, [Symbol e])
 -> Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e])))
-> Set (State (n, [Symbol e]))
-> Set (State (n, [Symbol e]))
-> Set (State (n, [Symbol e]))
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (Set (State (n, [Symbol e]))
-> Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e]))
forall c a. Container c a => c -> c -> c
union (Set (State (n, [Symbol e]))
 -> Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e])))
-> (State (n, [Symbol e]) -> Set (State (n, [Symbol e])))
-> State (n, [Symbol e])
-> Set (State (n, [Symbol e]))
-> Set (State (n, [Symbol e]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA (n, [Symbol e]) e
-> [Symbol e]
-> State (n, [Symbol e])
-> Set (State (n, [Symbol e]))
forall n e.
(Ord n, Ord e) =>
FSA n e -> [Symbol e] -> State n -> Set (State n)
follow FSA (n, [Symbol e]) e
monoid (State (n, [Symbol e]) -> [Symbol e]
forall {a} {c}. State (a, c) -> c
s State (n, [Symbol e])
e)) Set (State (n, [Symbol e]))
forall c a. Container c a => c
empty
>                 (Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e])))
-> Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e]))
forall a b. (a -> b) -> a -> b
$ Set (State (n, [Symbol e]))
x
>     where x :: Set (State (n, [Symbol e]))
x = FSA (n, [Symbol e]) e
-> State (n, [Symbol e]) -> Set (State (n, [Symbol e]))
forall n e.
(Ord n, Ord e) =>
FSA (n, [Symbol e]) e
-> State (n, [Symbol e]) -> Set (State (n, [Symbol e]))
me FSA (n, [Symbol e]) e
monoid State (n, [Symbol e])
e
>           s :: State (a, c) -> c
s = (a, c) -> c
forall a b. (a, b) -> b
snd ((a, c) -> c) -> (State (a, c) -> (a, c)) -> State (a, c) -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State (a, c) -> (a, c)
forall n. State n -> n
nodeLabel

ese is e*S*e: first go wherever you can from e, then take another e.

> -- |The semigroup multiplied on the left and right
> -- by the given idempotent.
> ese :: (Ord n, Ord e) => FSA (n, [Symbol e]) e
>     -> State (n, [Symbol e]) -> Set (State (n, [Symbol e]))
> ese :: forall n e.
(Ord n, Ord e) =>
FSA (n, [Symbol e]) e
-> State (n, [Symbol e]) -> Set (State (n, [Symbol e]))
ese FSA (n, [Symbol e]) e
sg State (n, [Symbol e])
e = (State (n, [Symbol e])
 -> Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e])))
-> Set (State (n, [Symbol e]))
-> Set (State (n, [Symbol e]))
-> Set (State (n, [Symbol e]))
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (Set (State (n, [Symbol e]))
-> Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e]))
forall c a. Container c a => c -> c -> c
union (Set (State (n, [Symbol e]))
 -> Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e])))
-> (State (n, [Symbol e]) -> Set (State (n, [Symbol e])))
-> State (n, [Symbol e])
-> Set (State (n, [Symbol e]))
-> Set (State (n, [Symbol e]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA (n, [Symbol e]) e
-> [Symbol e]
-> State (n, [Symbol e])
-> Set (State (n, [Symbol e]))
forall n e.
(Ord n, Ord e) =>
FSA n e -> [Symbol e] -> State n -> Set (State n)
follow FSA (n, [Symbol e]) e
sg (State (n, [Symbol e]) -> [Symbol e]
forall {a} {c}. State (a, c) -> c
s State (n, [Symbol e])
e)) Set (State (n, [Symbol e]))
forall c a. Container c a => c
empty Set (State (n, [Symbol e]))
es
>     where es :: Set (State (n, [Symbol e]))
es = FSA (n, [Symbol e]) e
-> State (n, [Symbol e]) -> Set (State (n, [Symbol e]))
forall n e. (Ord n, Ord e) => FSA n e -> State n -> Set (State n)
primitiveIdealR FSA (n, [Symbol e]) e
sg State (n, [Symbol e])
e
>           s :: State (a, c) -> c
s = (a, c) -> c
forall a b. (a, b) -> b
snd ((a, c) -> c) -> (State (a, c) -> (a, c)) -> State (a, c) -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State (a, c) -> (a, c)
forall n. State n -> n
nodeLabel


Commutativity
=============

Testing commutativity by checking that all elements commute with one another.

> -- |True iff the supplied elements commute with one another
> -- in the provided monoid.
> isCommutative :: (Ord n, Ord e) => FSA (n, [Symbol e]) e
>               -> Set (State (n, [Symbol e])) -> Bool
> isCommutative :: forall n e.
(Ord n, Ord e) =>
FSA (n, [Symbol e]) e -> Set (State (n, [Symbol e])) -> Bool
isCommutative FSA (n, [Symbol e]) e
f Set (State (n, [Symbol e]))
ss = ((State (n, [Symbol e]), State (n, [Symbol e])) -> Bool)
-> Set (State (n, [Symbol e]), State (n, [Symbol e])) -> Bool
forall (s :: * -> *) a. Collapsible s => (a -> Bool) -> s a -> Bool
allS ((State (n, [Symbol e]) -> State (n, [Symbol e]) -> Bool)
-> (State (n, [Symbol e]), State (n, [Symbol e])) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry State (n, [Symbol e]) -> State (n, [Symbol e]) -> Bool
commute) (Set (State (n, [Symbol e]))
-> Set (State (n, [Symbol e]), State (n, [Symbol e]))
forall a. Ord a => Set a -> Set (a, a)
pairs Set (State (n, [Symbol e]))
ss)
>     where commute :: State (n, [Symbol e]) -> State (n, [Symbol e]) -> Bool
commute State (n, [Symbol e])
u State (n, [Symbol e])
v = FSA (n, [Symbol e]) e
-> [Symbol e]
-> State (n, [Symbol e])
-> Set (State (n, [Symbol e]))
forall n e.
(Ord n, Ord e) =>
FSA n e -> [Symbol e] -> State n -> Set (State n)
follow FSA (n, [Symbol e]) e
f ((n, [Symbol e]) -> [Symbol e]
forall a b. (a, b) -> b
snd ((n, [Symbol e]) -> [Symbol e]) -> (n, [Symbol e]) -> [Symbol e]
forall a b. (a -> b) -> a -> b
$ State (n, [Symbol e]) -> (n, [Symbol e])
forall n. State n -> n
nodeLabel State (n, [Symbol e])
u) State (n, [Symbol e])
v Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e])) -> Bool
forall a. Eq a => a -> a -> Bool
==
>                         FSA (n, [Symbol e]) e
-> [Symbol e]
-> State (n, [Symbol e])
-> Set (State (n, [Symbol e]))
forall n e.
(Ord n, Ord e) =>
FSA n e -> [Symbol e] -> State n -> Set (State n)
follow FSA (n, [Symbol e]) e
f ((n, [Symbol e]) -> [Symbol e]
forall a b. (a, b) -> b
snd ((n, [Symbol e]) -> [Symbol e]) -> (n, [Symbol e]) -> [Symbol e]
forall a b. (a -> b) -> a -> b
$ State (n, [Symbol e]) -> (n, [Symbol e])
forall n. State n -> n
nodeLabel State (n, [Symbol e])
v) State (n, [Symbol e])
u


Powers
======

An element x is idempotent iff xx == x.
Here we use the syntactic monoid and simply exclude the identity
if it does not appear in the syntactic semigroup.

> -- |All elements \(e\) of the given monoid such that \(e*e=e\).
> -- Except the null word.  Add that manually if you need it.
> idempotents :: (Ord n, Ord e) => FSA (n, [Symbol e]) e
>             -> Set (State (n, [Symbol e]))
> idempotents :: forall n e.
(Ord n, Ord e) =>
FSA (n, [Symbol e]) e -> Set (State (n, [Symbol e]))
idempotents FSA (n, [Symbol e]) e
f = (State (n, [Symbol e]) -> Bool)
-> Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e]))
forall (s :: * -> *) a.
(Collapsible s, Container (s a) a) =>
(a -> Bool) -> s a -> s a
keep State (n, [Symbol e]) -> Bool
isIdem (Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e])))
-> (Set (Transition (n, [Symbol e]) e)
    -> Set (State (n, [Symbol e])))
-> Set (Transition (n, [Symbol e]) e)
-> Set (State (n, [Symbol e]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transition (n, [Symbol e]) e -> State (n, [Symbol e]))
-> Set (Transition (n, [Symbol e]) e)
-> Set (State (n, [Symbol e]))
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap Transition (n, [Symbol e]) e -> State (n, [Symbol e])
forall n e. Transition n e -> State n
destination (Set (Transition (n, [Symbol e]) e) -> Set (State (n, [Symbol e])))
-> Set (Transition (n, [Symbol e]) e)
-> Set (State (n, [Symbol e]))
forall a b. (a -> b) -> a -> b
$ FSA (n, [Symbol e]) e -> Set (Transition (n, [Symbol e]) e)
forall n e. FSA n e -> Set (Transition n e)
transitions FSA (n, [Symbol e]) e
f
>     where isIdem :: State (n, [Symbol e]) -> Bool
isIdem State (n, [Symbol e])
x = FSA (n, [Symbol e]) e
-> [Symbol e]
-> State (n, [Symbol e])
-> Set (State (n, [Symbol e]))
forall n e.
(Ord n, Ord e) =>
FSA n e -> [Symbol e] -> State n -> Set (State n)
follow FSA (n, [Symbol e]) e
f ((n, [Symbol e]) -> [Symbol e]
forall a b. (a, b) -> b
snd ((n, [Symbol e]) -> [Symbol e]) -> (n, [Symbol e]) -> [Symbol e]
forall a b. (a -> b) -> a -> b
$ State (n, [Symbol e]) -> (n, [Symbol e])
forall n. State n -> n
nodeLabel State (n, [Symbol e])
x) State (n, [Symbol e])
x Set (State (n, [Symbol e])) -> Set (State (n, [Symbol e])) -> Bool
forall a. Eq a => a -> a -> Bool
== State (n, [Symbol e]) -> Set (State (n, [Symbol e]))
forall c a. Container c a => a -> c
singleton State (n, [Symbol e])
x

> -- |@omega monoid s@ is the unique element \(t\) where \(t*t\) = \(t\)
> -- and \(t\) is in \(\{s, s^2, s^3, \ldots\}\).
> -- In other words, \(t\) is the unique idempotent element
> -- in this set.
> omega :: (Ord n, Ord e) => FSA (n, [Symbol e]) e
>       -> State (n, [Symbol e]) -> State (n, [Symbol e])
> omega :: forall n e.
(Ord n, Ord e) =>
FSA (n, [Symbol e]) e
-> State (n, [Symbol e]) -> State (n, [Symbol e])
omega FSA (n, [Symbol e]) e
monoid State (n, [Symbol e])
s = (State (n, [Symbol e]), State (n, [Symbol e]))
-> State (n, [Symbol e])
forall a b. (a, b) -> a
fst ((State (n, [Symbol e]), State (n, [Symbol e]))
 -> State (n, [Symbol e]))
-> ((State (n, [Symbol e]), State (n, [Symbol e]))
    -> (State (n, [Symbol e]), State (n, [Symbol e])))
-> (State (n, [Symbol e]), State (n, [Symbol e]))
-> State (n, [Symbol e])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((State (n, [Symbol e]), State (n, [Symbol e])) -> Bool)
-> ((State (n, [Symbol e]), State (n, [Symbol e]))
    -> (State (n, [Symbol e]), State (n, [Symbol e])))
-> (State (n, [Symbol e]), State (n, [Symbol e]))
-> (State (n, [Symbol e]), State (n, [Symbol e]))
forall a. (a -> Bool) -> (a -> a) -> a -> a
until ((State (n, [Symbol e]) -> State (n, [Symbol e]) -> Bool)
-> (State (n, [Symbol e]), State (n, [Symbol e])) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry State (n, [Symbol e]) -> State (n, [Symbol e]) -> Bool
forall a. Eq a => a -> a -> Bool
(==)) (\(State (n, [Symbol e])
a,State (n, [Symbol e])
_) -> State (n, [Symbol e])
-> (State (n, [Symbol e]), State (n, [Symbol e]))
f (State (n, [Symbol e]) -> State (n, [Symbol e])
next State (n, [Symbol e])
a)) ((State (n, [Symbol e]), State (n, [Symbol e]))
 -> State (n, [Symbol e]))
-> (State (n, [Symbol e]), State (n, [Symbol e]))
-> State (n, [Symbol e])
forall a b. (a -> b) -> a -> b
$ State (n, [Symbol e])
-> (State (n, [Symbol e]), State (n, [Symbol e]))
f State (n, [Symbol e])
s
>     where square :: State (n, [Symbol e]) -> State (n, [Symbol e])
square State (n, [Symbol e])
x = Set (State (n, [Symbol e])) -> State (n, [Symbol e])
forall a. Set a -> a
Set.findMin (Set (State (n, [Symbol e])) -> State (n, [Symbol e]))
-> Set (State (n, [Symbol e])) -> State (n, [Symbol e])
forall a b. (a -> b) -> a -> b
$ FSA (n, [Symbol e]) e
-> [Symbol e]
-> State (n, [Symbol e])
-> Set (State (n, [Symbol e]))
forall n e.
(Ord n, Ord e) =>
FSA n e -> [Symbol e] -> State n -> Set (State n)
follow FSA (n, [Symbol e]) e
monoid ((n, [Symbol e]) -> [Symbol e]
forall a b. (a, b) -> b
snd (State (n, [Symbol e]) -> (n, [Symbol e])
forall n. State n -> n
nodeLabel State (n, [Symbol e])
x)) State (n, [Symbol e])
x
>           next :: State (n, [Symbol e]) -> State (n, [Symbol e])
next   State (n, [Symbol e])
x = Set (State (n, [Symbol e])) -> State (n, [Symbol e])
forall a. Set a -> a
Set.findMin (Set (State (n, [Symbol e])) -> State (n, [Symbol e]))
-> Set (State (n, [Symbol e])) -> State (n, [Symbol e])
forall a b. (a -> b) -> a -> b
$ FSA (n, [Symbol e]) e
-> [Symbol e]
-> State (n, [Symbol e])
-> Set (State (n, [Symbol e]))
forall n e.
(Ord n, Ord e) =>
FSA n e -> [Symbol e] -> State n -> Set (State n)
follow FSA (n, [Symbol e]) e
monoid ((n, [Symbol e]) -> [Symbol e]
forall a b. (a, b) -> b
snd (State (n, [Symbol e]) -> (n, [Symbol e])
forall n. State n -> n
nodeLabel State (n, [Symbol e])
s)) State (n, [Symbol e])
x
>           f :: State (n, [Symbol e])
-> (State (n, [Symbol e]), State (n, [Symbol e]))
f      State (n, [Symbol e])
x = (State (n, [Symbol e])
x, State (n, [Symbol e]) -> State (n, [Symbol e])
square State (n, [Symbol e])
x)

> -- |Construct a monoid based on the idempotent paths
> -- as described by Straubing (1985).  Elements are of the form
> -- \((e,esf,f)\) for idempotents \(e\) and \(f\) and arbitrary \(s\).
> --
> -- @since 1.1
> emblock :: (Ord n, Ord e) => SynMon n e -> SynMon Integer Integer
> emblock :: forall n e. (Ord n, Ord e) => SynMon n e -> SynMon Integer Integer
emblock = FSA Integer Integer -> SynMon Integer Integer
forall e n.
(Ord e, Ord n) =>
FSA n e -> FSA ([Maybe n], [Symbol e]) e
syntacticMonoid (FSA Integer Integer -> SynMon Integer Integer)
-> (SynMon n e -> FSA Integer Integer)
-> SynMon n e
-> SynMon Integer Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA ([e], [e], [e]) Integer -> FSA Integer Integer
forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates (FSA ([e], [e], [e]) Integer -> FSA Integer Integer)
-> (SynMon n e -> FSA ([e], [e], [e]) Integer)
-> SynMon n e
-> FSA Integer Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA ([e], [e], [e]) ([e], [e], [e]) -> FSA ([e], [e], [e]) Integer
forall {e} {e1} {n}.
(Ord e, Ord e1, Ord n, Enum e1, Num e1) =>
FSA n e -> FSA n e1
renameSymbols (FSA ([e], [e], [e]) ([e], [e], [e])
 -> FSA ([e], [e], [e]) Integer)
-> (SynMon n e -> FSA ([e], [e], [e]) ([e], [e], [e]))
-> SynMon n e
-> FSA ([e], [e], [e]) Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynMon n e -> FSA ([e], [e], [e]) ([e], [e], [e])
forall n e.
(Ord n, Ord e) =>
SynMon n e -> FSA ([e], [e], [e]) ([e], [e], [e])
emblock'
>     where renameSymbols :: FSA n e -> FSA n e1
renameSymbols FSA n e
f = (e -> e1) -> FSA n e -> FSA n e1
forall e e1 n.
(Ord e, Ord e1, Ord n) =>
(e -> e1) -> FSA n e -> FSA n e1
renameSymbolsBy e -> e1
index FSA n e
f
>               where syms :: [(e, e1)]
syms = [e] -> [e1] -> [(e, e1)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set e -> [e]
forall a. Set a -> [a]
Set.toList (Set e -> [e]) -> Set e -> [e]
forall a b. (a -> b) -> a -> b
$ FSA n e -> Set e
forall e. FSA n e -> Set e
forall (g :: * -> *) e. HasAlphabet g => g e -> Set e
alphabet FSA n e
f) [e1
1..]
>                     index :: e -> e1
index e
x = let xs :: [(e, e1)]
xs = ((e, e1) -> Bool) -> [(e, e1)] -> [(e, e1)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((e -> e -> Bool
forall a. Eq a => a -> a -> Bool
==e
x) (e -> Bool) -> ((e, e1) -> e) -> (e, e1) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e, e1) -> e
forall a b. (a, b) -> a
fst) [(e, e1)]
syms
>                               in case [(e, e1)]
xs of
>                                    []    -> e1
0
>                                    ((e, e1)
y:[(e, e1)]
_) -> (e, e1) -> e1
forall a b. (a, b) -> b
snd (e, e1)
y

> emblock' :: (Ord n, Ord e) => SynMon n e
>          -> FSA ([e],[e],[e]) ([e],[e],[e])
> emblock' :: forall n e.
(Ord n, Ord e) =>
SynMon n e -> FSA ([e], [e], [e]) ([e], [e], [e])
emblock' SynMon n e
s = FSA { sigma :: Set ([e], [e], [e])
sigma = [([e], [e], [e])] -> Set ([e], [e], [e])
forall a. Ord a => [a] -> Set a
Set.fromList ([([e], [e], [e])] -> Set ([e], [e], [e]))
-> [([e], [e], [e])] -> Set ([e], [e], [e])
forall a b. (a -> b) -> a -> b
$ (Transition ([e], [e], [e]) ([e], [e], [e]) -> ([e], [e], [e]))
-> [Transition ([e], [e], [e]) ([e], [e], [e])]
-> [([e], [e], [e])]
forall a b. (a -> b) -> [a] -> [b]
map (State ([e], [e], [e]) -> ([e], [e], [e])
forall n. State n -> n
nodeLabel (State ([e], [e], [e]) -> ([e], [e], [e]))
-> (Transition ([e], [e], [e]) ([e], [e], [e])
    -> State ([e], [e], [e]))
-> Transition ([e], [e], [e]) ([e], [e], [e])
-> ([e], [e], [e])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transition ([e], [e], [e]) ([e], [e], [e]) -> State ([e], [e], [e])
forall n e. Transition n e -> State n
source) [Transition ([e], [e], [e]) ([e], [e], [e])]
trs
>                  , transitions :: Set (Transition ([e], [e], [e]) ([e], [e], [e]))
transitions = [Transition ([e], [e], [e]) ([e], [e], [e])]
-> Set (Transition ([e], [e], [e]) ([e], [e], [e]))
forall a. Ord a => [a] -> Set a
Set.fromList ([Transition ([e], [e], [e]) ([e], [e], [e])]
trs [Transition ([e], [e], [e]) ([e], [e], [e])]
-> [Transition ([e], [e], [e]) ([e], [e], [e])]
-> [Transition ([e], [e], [e]) ([e], [e], [e])]
forall a. [a] -> [a] -> [a]
++ [Transition ([e], [e], [e]) ([e], [e], [e])]
itrs)
>                  , initials :: Set (State ([e], [e], [e]))
initials = State ([e], [e], [e]) -> Set (State ([e], [e], [e]))
forall a. a -> Set a
Set.singleton (([e], [e], [e]) -> State ([e], [e], [e])
forall n. n -> State n
State ([],[],[]))
>                  , finals :: Set (State ([e], [e], [e]))
finals = Set (State ([e], [e], [e]))
forall a. Set a
Set.empty
>                  , isDeterministic :: Bool
isDeterministic = Bool
True
>                  }
>     where es :: [[e]]
es = (State ([Maybe n], [Symbol e]) -> [e])
-> [State ([Maybe n], [Symbol e])] -> [[e]]
forall a b. (a -> b) -> [a] -> [b]
map State ([Maybe n], [Symbol e]) -> [e]
forall {a} {e}. State (a, [Symbol e]) -> [e]
h ([State ([Maybe n], [Symbol e])] -> [[e]])
-> (Set (State ([Maybe n], [Symbol e]))
    -> [State ([Maybe n], [Symbol e])])
-> Set (State ([Maybe n], [Symbol e]))
-> [[e]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (State ([Maybe n], [Symbol e]))
-> [State ([Maybe n], [Symbol e])]
forall a. Set a -> [a]
Set.toList (Set (State ([Maybe n], [Symbol e])) -> [[e]])
-> Set (State ([Maybe n], [Symbol e])) -> [[e]]
forall a b. (a -> b) -> a -> b
$ SynMon n e -> Set (State ([Maybe n], [Symbol e]))
forall n e.
(Ord n, Ord e) =>
FSA (n, [Symbol e]) e -> Set (State (n, [Symbol e]))
idempotents SynMon n e
s
>           qs :: [[e]]
qs = (State ([Maybe n], [Symbol e]) -> [e])
-> [State ([Maybe n], [Symbol e])] -> [[e]]
forall a b. (a -> b) -> [a] -> [b]
map State ([Maybe n], [Symbol e]) -> [e]
forall {a} {e}. State (a, [Symbol e]) -> [e]
h ([State ([Maybe n], [Symbol e])] -> [[e]])
-> (Set (State ([Maybe n], [Symbol e]))
    -> [State ([Maybe n], [Symbol e])])
-> Set (State ([Maybe n], [Symbol e]))
-> [[e]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (State ([Maybe n], [Symbol e]))
-> [State ([Maybe n], [Symbol e])]
forall a. Set a -> [a]
Set.toList (Set (State ([Maybe n], [Symbol e])) -> [[e]])
-> Set (State ([Maybe n], [Symbol e])) -> [[e]]
forall a b. (a -> b) -> a -> b
$ SynMon n e -> Set (State ([Maybe n], [Symbol e]))
forall e n. (Ord e, Ord n) => FSA n e -> Set (State n)
states SynMon n e
s
>           ismon :: Bool
ismon = SynMon n e -> Set (State ([Maybe n], [Symbol e]))
forall n e. FSA n e -> Set (State n)
initials SynMon n e
s Set (State ([Maybe n], [Symbol e]))
-> Set (State ([Maybe n], [Symbol e])) -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` SynMon n e -> Set (State ([Maybe n], [Symbol e]))
forall n e.
(Ord n, Ord e) =>
FSA (n, [Symbol e]) e -> Set (State (n, [Symbol e]))
idempotents SynMon n e
s
>           h :: State (a, [Symbol e]) -> [e]
h = ([] [e] -> [e] -> [e]
forall a. [a] -> [a] -> [a]
++) ([e] -> [e])
-> (State (a, [Symbol e]) -> [e]) -> State (a, [Symbol e]) -> [e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol e] -> [e]
forall (s :: * -> *) c e.
(Collapsible s, Container c e, Monoid c) =>
s (Symbol e) -> c
unsymbols ([Symbol e] -> [e])
-> (State (a, [Symbol e]) -> [Symbol e])
-> State (a, [Symbol e])
-> [e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [Symbol e]) -> [Symbol e]
forall a b. (a, b) -> b
snd ((a, [Symbol e]) -> [Symbol e])
-> (State (a, [Symbol e]) -> (a, [Symbol e]))
-> State (a, [Symbol e])
-> [Symbol e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State (a, [Symbol e]) -> (a, [Symbol e])
forall n. State n -> n
nodeLabel
>           go :: t [e]
-> State ([Maybe n], [Symbol e]) -> State ([Maybe n], [Symbol e])
go t [e]
xs State ([Maybe n], [Symbol e])
q = (State ([Maybe n], [Symbol e]),
 Set (State ([Maybe n], [Symbol e])))
-> State ([Maybe n], [Symbol e])
forall a b. (a, b) -> a
fst ((State ([Maybe n], [Symbol e]),
  Set (State ([Maybe n], [Symbol e])))
 -> State ([Maybe n], [Symbol e]))
-> (Set (State ([Maybe n], [Symbol e]))
    -> (State ([Maybe n], [Symbol e]),
        Set (State ([Maybe n], [Symbol e]))))
-> Set (State ([Maybe n], [Symbol e]))
-> State ([Maybe n], [Symbol e])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (State ([Maybe n], [Symbol e]))
-> (State ([Maybe n], [Symbol e]),
    Set (State ([Maybe n], [Symbol e])))
forall a. Set a -> (a, Set a)
forall (l :: * -> *) a. Linearizable l => l a -> (a, l a)
choose (Set (State ([Maybe n], [Symbol e]))
 -> State ([Maybe n], [Symbol e]))
-> Set (State ([Maybe n], [Symbol e]))
-> State ([Maybe n], [Symbol e])
forall a b. (a -> b) -> a -> b
$ SynMon n e
-> [Symbol e]
-> State ([Maybe n], [Symbol e])
-> Set (State ([Maybe n], [Symbol e]))
forall n e.
(Ord n, Ord e) =>
FSA n e -> [Symbol e] -> State n -> Set (State n)
follow SynMon n e
s ((e -> Symbol e) -> [e] -> [Symbol e]
forall a b. (a -> b) -> [a] -> [b]
map e -> Symbol e
forall e. e -> Symbol e
Symbol ([e] -> [Symbol e]) -> [e] -> [Symbol e]
forall a b. (a -> b) -> a -> b
$ t [e] -> [e]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [e]
xs) State ([Maybe n], [Symbol e])
q
>           q0 :: State ([Maybe n], [Symbol e])
q0 = (State ([Maybe n], [Symbol e]),
 Set (State ([Maybe n], [Symbol e])))
-> State ([Maybe n], [Symbol e])
forall a b. (a, b) -> a
fst ((State ([Maybe n], [Symbol e]),
  Set (State ([Maybe n], [Symbol e])))
 -> State ([Maybe n], [Symbol e]))
-> (Set (State ([Maybe n], [Symbol e]))
    -> (State ([Maybe n], [Symbol e]),
        Set (State ([Maybe n], [Symbol e]))))
-> Set (State ([Maybe n], [Symbol e]))
-> State ([Maybe n], [Symbol e])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (State ([Maybe n], [Symbol e]))
-> (State ([Maybe n], [Symbol e]),
    Set (State ([Maybe n], [Symbol e])))
forall a. Set a -> (a, Set a)
forall (l :: * -> *) a. Linearizable l => l a -> (a, l a)
choose (Set (State ([Maybe n], [Symbol e]))
 -> State ([Maybe n], [Symbol e]))
-> Set (State ([Maybe n], [Symbol e]))
-> State ([Maybe n], [Symbol e])
forall a b. (a -> b) -> a -> b
$ SynMon n e -> Set (State ([Maybe n], [Symbol e]))
forall n e. FSA n e -> Set (State n)
initials SynMon n e
s
>           trs :: [Transition ([e], [e], [e]) ([e], [e], [e])]
trs = [let exf :: State ([Maybe n], [Symbol e])
exf = [[e]]
-> State ([Maybe n], [Symbol e]) -> State ([Maybe n], [Symbol e])
forall {t :: * -> *}.
Foldable t =>
t [e]
-> State ([Maybe n], [Symbol e]) -> State ([Maybe n], [Symbol e])
go [[e]
e,[e]
x,[e]
f] State ([Maybe n], [Symbol e])
q0
>                      fyg :: State ([Maybe n], [Symbol e])
fyg = [[e]]
-> State ([Maybe n], [Symbol e]) -> State ([Maybe n], [Symbol e])
forall {t :: * -> *}.
Foldable t =>
t [e]
-> State ([Maybe n], [Symbol e]) -> State ([Maybe n], [Symbol e])
go [[e]
f,[e]
y,[e]
g] State ([Maybe n], [Symbol e])
q0
>                  in Transition { source :: State ([e], [e], [e])
source      = ([e], [e], [e]) -> State ([e], [e], [e])
forall n. n -> State n
State ([e]
e, State ([Maybe n], [Symbol e]) -> [e]
forall {a} {e}. State (a, [Symbol e]) -> [e]
h State ([Maybe n], [Symbol e])
exf, [e]
f)
>                                , destination :: State ([e], [e], [e])
destination = ([e], [e], [e]) -> State ([e], [e], [e])
forall n. n -> State n
State
>                                                ([e]
e,State ([Maybe n], [Symbol e]) -> [e]
forall {a} {e}. State (a, [Symbol e]) -> [e]
h (State ([Maybe n], [Symbol e]) -> [e])
-> State ([Maybe n], [Symbol e]) -> [e]
forall a b. (a -> b) -> a -> b
$ [[e]]
-> State ([Maybe n], [Symbol e]) -> State ([Maybe n], [Symbol e])
forall {t :: * -> *}.
Foldable t =>
t [e]
-> State ([Maybe n], [Symbol e]) -> State ([Maybe n], [Symbol e])
go [State ([Maybe n], [Symbol e]) -> [e]
forall {a} {e}. State (a, [Symbol e]) -> [e]
h State ([Maybe n], [Symbol e])
fyg] State ([Maybe n], [Symbol e])
exf,[e]
g)
>                                , edgeLabel :: Symbol ([e], [e], [e])
edgeLabel   = ([e], [e], [e]) -> Symbol ([e], [e], [e])
forall e. e -> Symbol e
Symbol ([e]
f, State ([Maybe n], [Symbol e]) -> [e]
forall {a} {e}. State (a, [Symbol e]) -> [e]
h State ([Maybe n], [Symbol e])
fyg, [e]
g)
>                             }
>                 | [e]
e <- [[e]]
es, [e]
f <- [[e]]
es, [e]
g <- [[e]]
es
>                 , [e]
x <- [[e]]
qs, [e]
y <- [[e]]
qs
>                 ]
>           itrs :: [Transition ([e], [e], [e]) ([e], [e], [e])]
itrs = if Bool
ismon
>                  then []
>                  else [Transition { source :: State ([e], [e], [e])
source = ([e], [e], [e]) -> State ([e], [e], [e])
forall n. n -> State n
State ([],[],[])
>                                   , destination :: State ([e], [e], [e])
destination = ([e], [e], [e]) -> State ([e], [e], [e])
forall n. n -> State n
State ([e], [e], [e])
p
>                                   , edgeLabel :: Symbol ([e], [e], [e])
edgeLabel = ([e], [e], [e]) -> Symbol ([e], [e], [e])
forall e. e -> Symbol e
Symbol ([e], [e], [e])
p
>                                   }
>                       | (Symbol ([e], [e], [e])
p) <- (Transition ([e], [e], [e]) ([e], [e], [e])
 -> Symbol ([e], [e], [e]))
-> [Transition ([e], [e], [e]) ([e], [e], [e])]
-> [Symbol ([e], [e], [e])]
forall a b. (a -> b) -> [a] -> [b]
map Transition ([e], [e], [e]) ([e], [e], [e])
-> Symbol ([e], [e], [e])
forall n e. Transition n e -> Symbol e
edgeLabel [Transition ([e], [e], [e]) ([e], [e], [e])]
trs
>                       ]

Syntactic Order
===============
Pin (1997) suggests the following parial order on syntactic semigroups:
s <= t iff for all u,v it holds that utv in L implies usv in L.
This is a weak partial order:
* reflexive: clear from construction
* antisymmetric:
  suppose x <= y and y <= x; then uxv in L iff uyv in L
  and thus x is Myhill-related to y.

The way the syntactic monoid is constructed,
this information does remain accessible, so we can generate this order.
We'll generate it as an FSA with only one sort of edge label,
where an edge exists from p to q iff p <= q.
The initial state is the identity and the finals are the finals.

> -- |Returns a machine whose states represent monoid elements
> -- and where a transition exists from \(p\) to \(q\)
> -- if and only if \(p\leq q\).
> --
> -- @since 1.1
> syntacticOrder :: (Ord n, Ord e) => SynMon n e -> FSA [e] ()
> syntacticOrder :: forall n e. (Ord n, Ord e) => SynMon n e -> FSA [e] ()
syntacticOrder SynMon n e
s = FSA
>                    { sigma :: Set ()
sigma = () -> Set ()
forall a. a -> Set a
Set.singleton ()
>                    , transitions :: Set (Transition [e] ())
transitions = [Transition [e] ()] -> Set (Transition [e] ())
forall a. Ord a => [a] -> Set a
Set.fromList
>                                    [ Transition { source :: State [e]
source = State ([Maybe n], [Symbol e]) -> State [e]
forall {a}. State (a, [Symbol e]) -> State [e]
f State ([Maybe n], [Symbol e])
x
>                                                 , destination :: State [e]
destination = State ([Maybe n], [Symbol e]) -> State [e]
forall {a}. State (a, [Symbol e]) -> State [e]
f State ([Maybe n], [Symbol e])
y
>                                                 , edgeLabel :: Symbol ()
edgeLabel = () -> Symbol ()
forall e. e -> Symbol e
Symbol ()
>                                                 }
>                                    | State ([Maybe n], [Symbol e])
x <- [State ([Maybe n], [Symbol e])]
q, State ([Maybe n], [Symbol e])
y <- [State ([Maybe n], [Symbol e])]
q, State ([Maybe n], [Symbol e])
x State ([Maybe n], [Symbol e])
-> State ([Maybe n], [Symbol e]) -> Bool
forall {a} {a}.
State (a, [Symbol e]) -> State (a, [Symbol e]) -> Bool
# State ([Maybe n], [Symbol e])
y
>                                    ]
>                    , initials :: Set (State [e])
initials = (State ([Maybe n], [Symbol e]) -> State [e])
-> Set (State ([Maybe n], [Symbol e])) -> Set (State [e])
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap State ([Maybe n], [Symbol e]) -> State [e]
forall {a}. State (a, [Symbol e]) -> State [e]
f (SynMon n e -> Set (State ([Maybe n], [Symbol e]))
forall n e. FSA n e -> Set (State n)
initials SynMon n e
s)
>                    , finals :: Set (State [e])
finals = (State ([Maybe n], [Symbol e]) -> State [e])
-> Set (State ([Maybe n], [Symbol e])) -> Set (State [e])
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap State ([Maybe n], [Symbol e]) -> State [e]
forall {a}. State (a, [Symbol e]) -> State [e]
f (SynMon n e -> Set (State ([Maybe n], [Symbol e]))
forall n e. FSA n e -> Set (State n)
finals SynMon n e
s)
>                    , isDeterministic :: Bool
isDeterministic = Bool
False
>                    }
>     where q :: [State ([Maybe n], [Symbol e])]
q = Set (State ([Maybe n], [Symbol e]))
-> [State ([Maybe n], [Symbol e])]
forall a. Set a -> [a]
Set.toList (Set (State ([Maybe n], [Symbol e]))
 -> [State ([Maybe n], [Symbol e])])
-> Set (State ([Maybe n], [Symbol e]))
-> [State ([Maybe n], [Symbol e])]
forall a b. (a -> b) -> a -> b
$ SynMon n e -> Set (State ([Maybe n], [Symbol e]))
forall e n. (Ord e, Ord n) => FSA n e -> Set (State n)
states SynMon n e
s
>           f :: State (a, [Symbol e]) -> State [e]
f = ((a, [Symbol e]) -> [e]) -> State (a, [Symbol e]) -> State [e]
forall a b. (a -> b) -> State a -> State b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Symbol e] -> [e]
forall (s :: * -> *) c e.
(Collapsible s, Container c e, Monoid c) =>
s (Symbol e) -> c
unsymbols ([Symbol e] -> [e])
-> ((a, [Symbol e]) -> [Symbol e]) -> (a, [Symbol e]) -> [e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [Symbol e]) -> [Symbol e]
forall a b. (a, b) -> b
snd)
>           g :: State (a, c) -> c
g = (a, c) -> c
forall a b. (a, b) -> b
snd ((a, c) -> c) -> (State (a, c) -> (a, c)) -> State (a, c) -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State (a, c) -> (a, c)
forall n. State n -> n
nodeLabel
>           State (a, [Symbol e])
x # :: State (a, [Symbol e]) -> State (a, [Symbol e]) -> Bool
# State (a, [Symbol e])
y = ([Symbol e] -> Bool) -> [[Symbol e]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (SynMon n e -> [e] -> Bool
forall e n. (Ord e, Ord n) => FSA n e -> [e] -> Bool
accepts SynMon n e
s ([e] -> Bool) -> ([Symbol e] -> [e]) -> [Symbol e] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol e] -> [e]
forall (s :: * -> *) c e.
(Collapsible s, Container c e, Monoid c) =>
s (Symbol e) -> c
unsymbols)
>                   [ State ([Maybe n], [Symbol e]) -> [Symbol e]
forall {a} {c}. State (a, c) -> c
g State ([Maybe n], [Symbol e])
u [Symbol e] -> [Symbol e] -> [Symbol e]
forall a. [a] -> [a] -> [a]
++ State (a, [Symbol e]) -> [Symbol e]
forall {a} {c}. State (a, c) -> c
g State (a, [Symbol e])
x [Symbol e] -> [Symbol e] -> [Symbol e]
forall a. [a] -> [a] -> [a]
++ State ([Maybe n], [Symbol e]) -> [Symbol e]
forall {a} {c}. State (a, c) -> c
g State ([Maybe n], [Symbol e])
v
>                   | State ([Maybe n], [Symbol e])
u <- [State ([Maybe n], [Symbol e])]
q, State ([Maybe n], [Symbol e])
v <- [State ([Maybe n], [Symbol e])]
q,
>                     SynMon n e -> [e] -> Bool
forall e n. (Ord e, Ord n) => FSA n e -> [e] -> Bool
accepts SynMon n e
s ([Symbol e] -> [e]
forall (s :: * -> *) c e.
(Collapsible s, Container c e, Monoid c) =>
s (Symbol e) -> c
unsymbols (State ([Maybe n], [Symbol e]) -> [Symbol e]
forall {a} {c}. State (a, c) -> c
g State ([Maybe n], [Symbol e])
u [Symbol e] -> [Symbol e] -> [Symbol e]
forall a. [a] -> [a] -> [a]
++ State (a, [Symbol e]) -> [Symbol e]
forall {a} {c}. State (a, c) -> c
g State (a, [Symbol e])
y [Symbol e] -> [Symbol e] -> [Symbol e]
forall a. [a] -> [a] -> [a]
++ State ([Maybe n], [Symbol e]) -> [Symbol e]
forall {a} {c}. State (a, c) -> c
g State ([Maybe n], [Symbol e])
v))
>                   ]


Helpers
=======

> pairs :: Ord a => Set a -> Set (a, a)
> pairs :: forall a. Ord a => Set a -> Set (a, a)
pairs Set a
xs = (a -> Set (a, a) -> Set (a, a))
-> Set (a, a) -> Set a -> Set (a, a)
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (Set (a, a) -> Set (a, a) -> Set (a, a)
forall c a. Container c a => c -> c -> c
union (Set (a, a) -> Set (a, a) -> Set (a, a))
-> (a -> Set (a, a)) -> a -> Set (a, a) -> Set (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Set (a, a)
forall {a}. a -> Set (a, a)
f) Set (a, a)
forall c a. Container c a => c
empty Set a
xs
>     where f :: a -> Set (a, a)
f a
x = (a -> (a, a)) -> Set a -> Set (a, a)
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic ((,) a
x) Set a
xs