> {-# OPTIONS_HADDOCK hide,show-extensions #-}
> {-# LANGUAGE Safe #-}
> {-|
> Module    : Data.Representation.FiniteSemigroup.Base
> Copyright : (c) 2023 Dakotah Lambert
> License   : MIT

> This module provides the primary operations for finite semigroups.
> -}

> module Data.Representation.FiniteSemigroup.Base
>     ( -- *Representations of Finite Semigroups
>       FiniteSemigroupRep(..)
>     , FSMult(getTable)
>     , GeneratedAction(bases,completion)
>       -- *Generation by Elements
>     , fromBases
>     , mapsInto
>     , independentBases
>     , subsemigroup
>     , asActions
>       -- *Derived Semigroups
>     , localSubsemigroup
>     , localSubmonoids
>     , emee
>     , dual
>     , monoid
>     , projectedSubsemigroup
>       -- *Ideals and Orders
>       -- |Here, an order is a reflexive, transitive relation
>       -- parameterized by semigroup.
>     , ideal2
>     , jleq
>       -- *Special Kinds of Elements
>     , neutralElement
>     , adjoinOne
>     , zeroElement
>     , adjoinZero
>     , idempotents
>     , omega
>     , omegas
>     , lClasses
>     , rClasses
>     ) where

> --import qualified Vector as V
> import Data.List ((\\), elemIndex, sort, sortBy, transpose)
> import Data.Ord (comparing)
> import qualified Data.List.NonEmpty as NE
> import Data.IntSet (IntSet)
> import qualified Data.Set as Set
> import qualified Data.IntSet as IntSet
> import Safe

> -- |A representation of a finite semigroup.
> -- Unlike the @Semigroup@ typeclass,
> -- this does not refer to a type whose objects
> -- collectively form a semigroup.
> -- Instead, it is a type
> -- whose objects individually represent semigroups.
> class FiniteSemigroupRep a where
>     -- |The multiplication of the semigroup.
>     fsappend :: a -> Int -> Int -> Int
>     fsappend a
s Int
x Int
y = forall a. a -> [a] -> Int -> a
atDef (-Int
1) (forall a. a -> [a] -> Int -> a
atDef [] (FSMult -> [[Int]]
getTable (forall a. FiniteSemigroupRep a => a -> FSMult
fstable a
s)) Int
x) Int
y
>     -- |The multiplication table of the semigroup.
>     -- In the list at index @x@, the element at index @y@ is @xy@.
>     fstable :: a -> FSMult
>     fstable a
s
>         = let es :: [Int]
es = [Int
0..(forall a. FiniteSemigroupRep a => a -> Int
fssize a
s forall a. Num a => a -> a -> a
- Int
1)]
>           in Int -> [[Int]] -> FSMult
FSMult (forall a. FiniteSemigroupRep a => a -> Int
fsnbases a
s)
>              forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> forall a b. (a -> b) -> [a] -> [b]
map (\Int
y -> forall a. FiniteSemigroupRep a => a -> Int -> Int -> Int
fsappend a
s Int
x Int
y) [Int]
es) [Int]
es
>     -- |The number of elements in the semigroup.
>     fssize :: a -> Int
>     fssize = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSMult -> [[Int]]
getTable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FiniteSemigroupRep a => a -> FSMult
fstable
>     -- |The number of generators (always the first elements).
>     fsnbases :: a -> Int
>     fsnbases = forall a. FiniteSemigroupRep a => a -> Int
fssize
>     {-# MINIMAL (fsappend,fssize)|fstable #-}

A multiplication table can define a semigroup,
but we shall not allow direct creation of such objects
outside of this module, in order to ensure associativity.

> -- |A semigroup presented as a multiplication table.
> -- Use 'getTable' to extract the actual table;
> -- this type is otherwise opaque.
> data FSMult = FSMult { FSMult -> Int
basisRows :: Int
>                      , FSMult -> [[Int]]
getTable :: [[Int]]
>                      } deriving (FSMult -> FSMult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FSMult -> FSMult -> Bool
$c/= :: FSMult -> FSMult -> Bool
== :: FSMult -> FSMult -> Bool
$c== :: FSMult -> FSMult -> Bool
Eq, Eq FSMult
FSMult -> FSMult -> Bool
FSMult -> FSMult -> Ordering
FSMult -> FSMult -> FSMult
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
min :: FSMult -> FSMult -> FSMult
$cmin :: FSMult -> FSMult -> FSMult
max :: FSMult -> FSMult -> FSMult
$cmax :: FSMult -> FSMult -> FSMult
>= :: FSMult -> FSMult -> Bool
$c>= :: FSMult -> FSMult -> Bool
> :: FSMult -> FSMult -> Bool
$c> :: FSMult -> FSMult -> Bool
<= :: FSMult -> FSMult -> Bool
$c<= :: FSMult -> FSMult -> Bool
< :: FSMult -> FSMult -> Bool
$c< :: FSMult -> FSMult -> Bool
compare :: FSMult -> FSMult -> Ordering
$ccompare :: FSMult -> FSMult -> Ordering
Ord)
> instance FiniteSemigroupRep FSMult where
>     fstable :: FSMult -> FSMult
fstable FSMult
t = FSMult
t
>     fsnbases :: FSMult -> Int
fsnbases = FSMult -> Int
basisRows


Operations on Semigroups
========================

> -- |Return the elements that square to themselves
> -- as an ascending list.
> idempotents :: FiniteSemigroupRep s => s -> IntSet
> idempotents :: forall s. FiniteSemigroupRep s => s -> IntSet
idempotents = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, [Int]) -> IntSet -> IntSet
f IntSet
IntSet.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSMult -> [[Int]]
getTable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FiniteSemigroupRep a => a -> FSMult
fstable
>     where f :: (Int, [Int]) -> IntSet -> IntSet
f ~(Int
p,[Int]
x) = if forall a. [a] -> Int -> Maybe a
atMay [Int]
x Int
p forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Int
p
>                      then (Int
p Int -> IntSet -> IntSet
`IntSet.insert`)
>                      else forall a. a -> a
id

> -- |Return an action mapping semigroup elements
> -- to their unique idempotent powers.
> omegas :: FiniteSemigroupRep s => s -> [Int]
> omegas :: forall s. FiniteSemigroupRep s => s -> [Int]
omegas s
s = forall a b. (a -> b) -> [a] -> [b]
map (forall s. FiniteSemigroupRep s => s -> Int -> Int
omega s
s) [Int
0..forall a. FiniteSemigroupRep a => a -> Int
fssize s
s forall a. Num a => a -> a -> a
- Int
1]

> -- |Return the unique idempotent power of the given element.
> -- The result of @omega s i@ is the @i@th element of @omegas s@,
> -- if @i@ is a valid element index.
> omega :: FiniteSemigroupRep s => s -> Int -> Int
> omega :: forall s. FiniteSemigroupRep s => s -> Int -> Int
omega s
s Int
x = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> (a -> a) -> a -> a
until (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Eq a => a -> a -> Bool
(==)) (Int -> (Int, Int)
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (Int -> (Int, Int)
go Int
x)
>     where go :: Int -> (Int, Int)
go Int
a = let y :: Int
y = forall a. FiniteSemigroupRep a => a -> Int -> Int -> Int
fsappend s
s Int
x Int
a
>                  in (Int
y, forall a. FiniteSemigroupRep a => a -> Int -> Int -> Int
fsappend s
s Int
y Int
y)

> -- |Reverse the multiplication of the semigroup.
> dual :: FiniteSemigroupRep s => s -> FSMult
> dual :: forall a. FiniteSemigroupRep a => a -> FSMult
dual s
s = Int -> [[Int]] -> FSMult
FSMult (forall a. FiniteSemigroupRep a => a -> Int
fsnbases s
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
transpose forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSMult -> [[Int]]
getTable forall a b. (a -> b) -> a -> b
$ forall a. FiniteSemigroupRep a => a -> FSMult
fstable s
s

> -- |Partition the elements of the semigroup \(S\)
> -- such that distinct elements \(x\) and \(y\) are in the same region
> -- if and only if there are \(s\) and \(t\)
> -- such that \(y=sx\) and \(x=ty\).
> rClasses :: FiniteSemigroupRep s => s -> [NE.NonEmpty Int]
> rClasses :: forall s. FiniteSemigroupRep s => s -> [NonEmpty Int]
rClasses = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy (forall b a. Eq b => (a -> b) -> a -> a -> Bool
equal forall a b. (a, b) -> a
fst)
>            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Int, [Int])
p -> ((Int, [Int]) -> IntSet
row (Int, [Int])
p, forall a b. (a, b) -> a
fst (Int, [Int])
p)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..]
>            forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSMult -> [[Int]]
getTable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FiniteSemigroupRep a => a -> FSMult
fstable
>     where row :: (Int, [Int]) -> IntSet
row (Int, [Int])
p = [Int] -> IntSet
IntSet.fromList forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) (Int, [Int])
p

> -- |Partition the elements of the semigroup \(S\)
> -- such that distinct elements \(x\) and \(y\) are in the same region
> -- if and only if there are \(s\) and \(t\)
> -- such that \(y=xs\) and \(x=yt\).
> lClasses :: FiniteSemigroupRep s => s -> [NE.NonEmpty Int]
> lClasses :: forall s. FiniteSemigroupRep s => s -> [NonEmpty Int]
lClasses = forall s. FiniteSemigroupRep s => s -> [NonEmpty Int]
rClasses forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FiniteSemigroupRep a => a -> FSMult
dual

> -- |Return the local subsemigroup of the given semigroup \(S\)
> -- formed by wrapping elements with the given element \(i\).
> -- That is, all and only elements of the form \(isi\) for \(s\in S\)
> -- are included.
> localSubsemigroup :: FiniteSemigroupRep s => s -> Int -> FSMult
> localSubsemigroup :: forall s. FiniteSemigroupRep s => s -> Int -> FSMult
localSubsemigroup s
s Int
i = FSMult -> [Int] -> FSMult
restrict FSMult
t [Int]
xs
>     where t :: FSMult
t = forall a. FiniteSemigroupRep a => a -> FSMult
fstable s
s
>           si :: [Int]
si = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. a -> [a] -> Int -> a
atDef []) Int
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSMult -> [[Int]]
getTable forall a b. (a -> b) -> a -> b
$ forall a. FiniteSemigroupRep a => a -> FSMult
dual FSMult
t
>           xs :: [Int]
xs = forall a b. (a -> b) -> [a] -> [b]
map (forall a. NonEmpty a -> a
NE.head) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. (Foldable f, Eq a) => f a -> [NonEmpty a]
NE.group forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort
>                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip [Int] -> [Int] -> [Int]
backpermute [Int]
si forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. a -> [a] -> Int -> a
atDef []) Int
i forall a b. (a -> b) -> a -> b
$ FSMult -> [[Int]]
getTable FSMult
t

> -- |Return the local subsemigroups of the given semigroup
> -- which happen to be monoids.
> -- These are the ones whose wrapping element is idempotent.
> -- If the semigroup itself is a monoid, it is in the list.
> localSubmonoids :: FiniteSemigroupRep s => s -> [FSMult]
> localSubmonoids :: forall s. FiniteSemigroupRep s => s -> [FSMult]
localSubmonoids s
s = forall a b. (a -> b) -> [a] -> [b]
map (forall s. FiniteSemigroupRep s => s -> Int -> FSMult
localSubsemigroup s
s)
>                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IntSet.toList forall a b. (a -> b) -> a -> b
$ forall s. FiniteSemigroupRep s => s -> IntSet
idempotents s
s

> -- |If the given semigroup is a monoid,
> -- return 'Just' its neutral element.
> -- Otherwise return 'Nothing'.
> neutralElement :: FiniteSemigroupRep s => s -> Maybe Int
> neutralElement :: forall s. FiniteSemigroupRep s => s -> Maybe Int
neutralElement s
s
>     = forall a. [a] -> Maybe a
headMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..]
>       forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Bool -> Bool
(&&)) (FSMult -> [[Bool]]
proper FSMult
t) (FSMult -> [[Bool]]
proper forall a b. (a -> b) -> a -> b
$ forall a. FiniteSemigroupRep a => a -> FSMult
dual FSMult
t)
>     where t :: FSMult
t = forall a. FiniteSemigroupRep a => a -> FSMult
fstable s
s
>           proper :: FSMult -> [[Bool]]
proper = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Eq a => a -> a -> Bool
(==) [Int
0..]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSMult -> [[Int]]
getTable

> -- |If the given semigroup has an element which is both a left-
> -- and right-zero, that is, an element e where \(ex=e=xe\)
> -- for all \(x\), return 'Just' that zero.
> -- Otherwise, return 'Nothing'.
> zeroElement :: FiniteSemigroupRep s => s -> Maybe Int
> zeroElement :: forall s. FiniteSemigroupRep s => s -> Maybe Int
zeroElement s
s = forall a. [a] -> Maybe a
headMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..]
>                 forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Bool -> Bool
(&&) (FSMult -> [Bool]
f FSMult
t) (FSMult -> [Bool]
f forall a b. (a -> b) -> a -> b
$ forall a. FiniteSemigroupRep a => a -> FSMult
dual FSMult
t)
>     where alleq :: a -> t a -> Bool
alleq a
x t a
xs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== a
x) t a
xs
>           f :: FSMult -> [Bool]
f = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {t :: * -> *} {a}. (Foldable t, Eq a) => a -> t a -> Bool
alleq [Int
0..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSMult -> [[Int]]
getTable
>           t :: FSMult
t = forall a. FiniteSemigroupRep a => a -> FSMult
fstable s
s

> -- |If the given semigroup is not a monoid, then it is returned as-is.
> -- Otherwise, the neutral element is removed if possible,
> -- that is, if it cannot be written in terms of other elements.
> projectedSubsemigroup :: FiniteSemigroupRep s => s -> FSMult
> projectedSubsemigroup :: forall a. FiniteSemigroupRep a => a -> FSMult
projectedSubsemigroup s
s = FSMult -> [Int] -> FSMult
restrict FSMult
t ([Int
0..forall a. FiniteSemigroupRep a => a -> Int
fssize FSMult
t forall a. Num a => a -> a -> a
- Int
1] forall a. Eq a => [a] -> [a] -> [a]
\\ [Int]
n)
>     where t :: FSMult
t = forall a. FiniteSemigroupRep a => a -> FSMult
fstable s
s
>           n :: [Int]
n = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Int -> [Int]
f forall a b. (a -> b) -> a -> b
$ forall s. FiniteSemigroupRep s => s -> Maybe Int
neutralElement FSMult
t
>           f :: Int -> [Int]
f Int
x = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
==Int
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ FSMult -> [[Int]]
getTable FSMult
t
>                 then [Int
x] else []


Ideals and Orders
=================

> -- |Given an element \(x\), return the set of elements
> -- representable as \(sxt\) for some \(s\) and \(t\) in \(S^1\),
> -- as a distinct ascending list.
> ideal2 :: FiniteSemigroupRep s => s -> Int -> IntSet
> ideal2 :: forall s. FiniteSemigroupRep s => s -> Int -> IntSet
ideal2 s
s Int
i = forall (f :: * -> *). Foldable f => f IntSet -> IntSet
IntSet.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> IntSet
IntSet.fromList)
>              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [Int] -> [a]
backpermuteDef []
>                (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (:) [Int
0..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSMult -> [[Int]]
getTable forall a b. (a -> b) -> a -> b
$ forall a. FiniteSemigroupRep a => a -> FSMult
dual s
s)
>              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. NonEmpty a -> a
NE.head) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. (Foldable f, Eq a) => f a -> [NonEmpty a]
NE.group forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort
>              forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
iforall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. a -> [a] -> Int -> a
atDef []) Int
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSMult -> [[Int]]
getTable forall a b. (a -> b) -> a -> b
$ forall a. FiniteSemigroupRep a => a -> FSMult
fstable s
s

> -- |The \(\mathcal{J}\)-order: \(x\leq y\) if and only if
> -- \(x=syt\) for some \(s\) and \(t\) in \(S^1\).
> jleq :: FiniteSemigroupRep s => s -> Int -> Int -> Bool
> jleq :: forall s. FiniteSemigroupRep s => s -> Int -> Int -> Bool
jleq s
s Int
x Int
y = Int
x Int -> IntSet -> Bool
`IntSet.member` forall s. FiniteSemigroupRep s => s -> Int -> IntSet
ideal2 s
s Int
y

> -- |Return the bases that are greater than or equal to
> -- each idempotent, with respect to the \(\mathcal{J}\)-order.
> me :: FiniteSemigroupRep s => s -> [IntSet]
> me :: forall s. FiniteSemigroupRep s => s -> [IntSet]
me s
s = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> [IntSet] -> [IntSet]
f (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const IntSet
IntSet.empty) [Int]
is)
>        [Int
0 .. forall a. FiniteSemigroupRep a => a -> Int
fsnbases s
s forall a. Num a => a -> a -> a
- Int
1]
>     where is :: [Int]
is = IntSet -> [Int]
IntSet.toList forall a b. (a -> b) -> a -> b
$ forall s. FiniteSemigroupRep s => s -> IntSet
idempotents s
s
>           f :: Int -> [IntSet] -> [IntSet]
f Int
b [IntSet]
a = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a b. (a -> b) -> a -> b
($) (forall a b. (a -> b) -> [a] -> [b]
map (Int -> IntSet -> Int -> IntSet -> IntSet
g Int
b (forall s. FiniteSemigroupRep s => s -> Int -> IntSet
ideal2 s
s Int
b)) [Int]
is) [IntSet]
a
>           g :: Int -> IntSet -> Int -> IntSet -> IntSet
g Int
b IntSet
p Int
i = if Int
i Int -> IntSet -> Bool
`IntSet.member` IntSet
p
>                     then Int -> IntSet -> IntSet
IntSet.insert Int
b else forall a. a -> a
id

> -- |Return a list of subsemigroups of the form
> -- \(e\cdot M_e\cdot e\) for idempotent \(e\),
> -- where \(M_e\) is the set of elements generated by those elements
> -- greater than or equal to \(e\) with respect to
> -- the \(\mathcal{J}\)-order.
> emee :: FiniteSemigroupRep s => s -> [FSMult]
> emee :: forall s. FiniteSemigroupRep s => s -> [FSMult]
emee s
s = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> IntSet -> FSMult
f (IntSet -> [Int]
IntSet.toList forall a b. (a -> b) -> a -> b
$ forall s. FiniteSemigroupRep s => s -> IntSet
idempotents s
s) (forall s. FiniteSemigroupRep s => s -> [IntSet]
me s
s)
>     where t :: FSMult
t = forall a. FiniteSemigroupRep a => a -> FSMult
fstable s
s
>           f :: Int -> IntSet -> FSMult
f Int
e = FSMult -> [Int] -> FSMult
restrict FSMult
t
>                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. NonEmpty a -> a
NE.head) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. (Foldable f, Eq a) => f a -> [NonEmpty a]
NE.group forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort
>                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. FiniteSemigroupRep a => a -> Int -> Int -> Int
fsappend s
s) Int
e [Int
e,Int
x])
>                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IntSet.toList
>                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. FiniteSemigroupRep s => s -> IntSet -> IntSet
subsemigroup s
s


Adjoining Elements
==================

> -- |Insert a new element \(e\) such that for all elements \(x\),
> -- it holds that \(ex=x=xe\).
> adjoinOne :: FiniteSemigroupRep s => s -> FSMult
> adjoinOne :: forall a. FiniteSemigroupRep a => a -> FSMult
adjoinOne s
s = Int -> [[Int]] -> FSMult
FSMult (forall a. FiniteSemigroupRep a => a -> Int
fsnbases s
s forall a. Num a => a -> a -> a
+ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {c}. (Num c, Enum c) => [[c]] -> [[c]]
f
>               forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a. Enum a => a -> a
succ)
>               forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSMult -> [[Int]]
getTable forall a b. (a -> b) -> a -> b
$ forall a. FiniteSemigroupRep a => a -> FSMult
fstable s
s
>     where f :: [[c]] -> [[c]]
f [[c]]
xs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a b. a -> b -> a
const [c
0..] ([]forall a. a -> [a] -> [a]
:[[c]]
xs) forall a. a -> [a] -> [a]
: [[c]]
xs

> -- |Insert a new element \(e\) such that for all elements \(x\),
> -- it holds that \(ex=e=xe\).
> adjoinZero :: FiniteSemigroupRep s => s -> FSMult
> adjoinZero :: forall a. FiniteSemigroupRep a => a -> FSMult
adjoinZero s
s = Int -> [[Int]] -> FSMult
FSMult (forall a. FiniteSemigroupRep a => a -> Int
fsnbases s
s forall a. Num a => a -> a -> a
+ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {c}. Num c => [[c]] -> [[c]]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((Int
0 forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Enum a => a -> a
succ)
>                forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSMult -> [[Int]]
getTable forall a b. (a -> b) -> a -> b
$ forall a. FiniteSemigroupRep a => a -> FSMult
fstable s
s
>     where f :: [[c]] -> [[c]]
f [[c]]
xs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a b. a -> b -> a
const (forall a. a -> [a]
repeat c
0) ([]forall a. a -> [a] -> [a]
:[[c]]
xs) forall a. a -> [a] -> [a]
: [[c]]
xs

> -- |If the given semigroup is already a monoid, returns it.
> -- Otherwise, returns a monoid by adjoining a neutral element.
> monoid :: FiniteSemigroupRep s => s -> FSMult
> monoid :: forall a. FiniteSemigroupRep a => a -> FSMult
monoid s
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. FiniteSemigroupRep a => a -> FSMult
adjoinOne s
s) (forall a b. a -> b -> a
const (forall a. FiniteSemigroupRep a => a -> FSMult
fstable s
s)) forall a b. (a -> b) -> a -> b
$ forall s. FiniteSemigroupRep s => s -> Maybe Int
neutralElement s
s


Generated Actions
=================

> -- |A semigroup presented as a collection of actions.
> -- The 'bases' are the given set of generating actions,
> -- while the 'completion' is the set of other semigroup elements.
> data GeneratedAction
>     = GeneratedAction { GeneratedAction -> [[Int]]
bases :: [[Int]]
>                       , GeneratedAction -> [[Int]]
completion :: [[Int]]
>                       }
>       deriving (GeneratedAction -> GeneratedAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GeneratedAction -> GeneratedAction -> Bool
$c/= :: GeneratedAction -> GeneratedAction -> Bool
== :: GeneratedAction -> GeneratedAction -> Bool
$c== :: GeneratedAction -> GeneratedAction -> Bool
Eq, Eq GeneratedAction
GeneratedAction -> GeneratedAction -> Bool
GeneratedAction -> GeneratedAction -> Ordering
GeneratedAction -> GeneratedAction -> GeneratedAction
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
min :: GeneratedAction -> GeneratedAction -> GeneratedAction
$cmin :: GeneratedAction -> GeneratedAction -> GeneratedAction
max :: GeneratedAction -> GeneratedAction -> GeneratedAction
$cmax :: GeneratedAction -> GeneratedAction -> GeneratedAction
>= :: GeneratedAction -> GeneratedAction -> Bool
$c>= :: GeneratedAction -> GeneratedAction -> Bool
> :: GeneratedAction -> GeneratedAction -> Bool
$c> :: GeneratedAction -> GeneratedAction -> Bool
<= :: GeneratedAction -> GeneratedAction -> Bool
$c<= :: GeneratedAction -> GeneratedAction -> Bool
< :: GeneratedAction -> GeneratedAction -> Bool
$c< :: GeneratedAction -> GeneratedAction -> Bool
compare :: GeneratedAction -> GeneratedAction -> Ordering
$ccompare :: GeneratedAction -> GeneratedAction -> Ordering
Ord)

> -- |Construct a semigroup from a set of generating transformations.
> -- Transformations are given as functions over an initial segment
> -- of the nonnegative integers.
> -- The transformation @[a,b,c]@ maps 0 to @a@, 1 to @b@, and 2 to @c@.
> fromBases :: [[Int]] -> GeneratedAction
> fromBases :: [[Int]] -> GeneratedAction
fromBases [] = GeneratedAction { bases :: [[Int]]
bases = [[Int
0]], completion :: [[Int]]
completion = [[Int
0]] }
> fromBases [[Int]]
ys = GeneratedAction
>                { bases :: [[Int]]
bases = [[Int]]
xs
>                , completion :: [[Int]]
completion = forall a. Set a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set [Int]
xs'
>                               forall a b. (a -> b) -> a -> b
$ Set [Int] -> Set [Int] -> Set [Int]
go forall a. Set a
Set.empty Set [Int]
xs'
>                }
>     where xs :: [[Int]]
xs = forall a. Set a -> [a]
Set.toList Set [Int]
xs'
>           xs' :: Set [Int]
xs' = forall a. Ord a => [a] -> Set a
Set.fromList [[Int]]
ys
>           go :: Set [Int] -> Set [Int] -> Set [Int]
go Set [Int]
done Set [Int]
new
>               | forall a. Set a -> Bool
Set.null Set [Int]
new = Set [Int]
done
>               | Bool
otherwise = Set [Int] -> Set [Int] -> Set [Int]
go Set [Int]
d (forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set [Int]
n Set [Int]
d)
>               where d :: Set [Int]
d = Set [Int]
done forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set [Int]
new
>                     n :: Set [Int]
n = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
>                         forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\[Int]
b -> forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map ([Int] -> [Int] -> [Int]
backpermute [Int]
b) Set [Int]
new) [[Int]]
xs

> -- |Returns the set of element indices
> -- in the given transformation that map the given object
> -- into the given set.
> mapsInto :: GeneratedAction -> IntSet -> Int -> IntSet
> mapsInto :: GeneratedAction -> IntSet -> Int -> IntSet
mapsInto GeneratedAction
s IntSet
h Int
q = [Int] -> IntSet
IntSet.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..]
>                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ( forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> IntSet -> Bool
`IntSet.member` IntSet
h)
>                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. [a] -> Int -> Maybe a
atMay Int
q )
>                  forall a b. (a -> b) -> a -> b
$ (GeneratedAction -> [[Int]]
bases GeneratedAction
s forall a. [a] -> [a] -> [a]
++ GeneratedAction -> [[Int]]
completion GeneratedAction
s)

> -- |The subsemigroup of the given semigroup
> -- generated by the indicated elements.
> subsemigroup :: FiniteSemigroupRep s => s -> IntSet -> IntSet
> subsemigroup :: forall s. FiniteSemigroupRep s => s -> IntSet -> IntSet
subsemigroup s
s IntSet
xs = IntSet -> IntSet -> IntSet
go IntSet
IntSet.empty IntSet
xs
>     where is :: [Int]
is = IntSet -> [Int]
IntSet.toList IntSet
xs
>           go :: IntSet -> IntSet -> IntSet
go IntSet
done IntSet
new
>               | IntSet -> Bool
IntSet.null IntSet
new = IntSet
done
>               | Bool
otherwise = IntSet -> IntSet -> IntSet
go IntSet
d (IntSet -> IntSet -> IntSet
IntSet.difference IntSet
n IntSet
d)
>               where d :: IntSet
d = IntSet
done IntSet -> IntSet -> IntSet
`IntSet.union` IntSet
new
>                     n :: IntSet
n = forall (f :: * -> *). Foldable f => f IntSet -> IntSet
IntSet.unions
>                         forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> (Int -> Int) -> IntSet -> IntSet
IntSet.map (forall a. FiniteSemigroupRep a => a -> Int -> Int -> Int
fsappend s
s Int
i) IntSet
new) [Int]
is

> -- |Create an action semigroup whose bases correspond
> -- to the given elements; for each element \(i\), there is a basis
> -- representing the transformation \(f(x)=xi\).
> asActions :: FiniteSemigroupRep s => s -> [Int] -> GeneratedAction
> asActions :: forall s. FiniteSemigroupRep s => s -> [Int] -> GeneratedAction
asActions s
s [Int]
is = [[Int]] -> GeneratedAction
fromBases forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. a -> [a] -> [Int] -> [a]
backpermuteDef []) [Int]
is
>                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSMult -> [[Int]]
getTable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FiniteSemigroupRep a => a -> FSMult
adjoinOne forall a b. (a -> b) -> a -> b
$ forall a. FiniteSemigroupRep a => a -> FSMult
dual s
s

> instance FiniteSemigroupRep GeneratedAction where
>     fsappend :: GeneratedAction -> Int -> Int -> Int
fsappend GeneratedAction
s Int
a Int
b = let c :: [[Int]]
c = GeneratedAction -> [[Int]]
bases GeneratedAction
s forall a. [a] -> [a] -> [a]
++ GeneratedAction -> [[Int]]
completion GeneratedAction
s
>                          x :: [Int]
x = forall a. a -> [a] -> Int -> a
atDef [] [[Int]]
c Int
a
>                          y :: [Int]
y = forall a. a -> [a] -> Int -> a
atDef [] [[Int]]
c Int
b
>                      in forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-Int
1) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> Maybe Int
elemIndex ([Int] -> [Int] -> [Int]
backpermute [Int]
y [Int]
x) [[Int]]
c
>     fssize :: GeneratedAction -> Int
fssize GeneratedAction
s = forall (t :: * -> *) a. Foldable t => t a -> Int
length (GeneratedAction -> [[Int]]
bases GeneratedAction
s) forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (GeneratedAction -> [[Int]]
completion GeneratedAction
s)
>     fsnbases :: GeneratedAction -> Int
fsnbases = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneratedAction -> [[Int]]
bases

> -- |Find a small set of basis elements such that
> -- none can be written in terms of the others
> -- and the entire semigroup can be written
> -- in terms of these bases.
> independentBases :: FiniteSemigroupRep s => s -> [[Int]]
> independentBases :: forall s. FiniteSemigroupRep s => s -> [[Int]]
independentBases = [[Int]] -> [[Int]] -> [[Int]]
go [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSMult -> [[Int]]
getTable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FiniteSemigroupRep a => a -> FSMult
adjoinOne forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FiniteSemigroupRep a => a -> FSMult
dual
>     where go :: [[Int]] -> [[Int]] -> [[Int]]
go [[Int]]
keep ([Int]
x:[[Int]]
xs)
>               | [Int]
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` GeneratedAction -> [[Int]]
completion ([[Int]] -> GeneratedAction
fromBases (forall a. [a] -> [a]
reverse [[Int]]
keep forall a. [a] -> [a] -> [a]
++ [[Int]]
xs))
>                   = [[Int]] -> [[Int]] -> [[Int]]
go [[Int]]
keep [[Int]]
xs
>               | Bool
otherwise = [[Int]] -> [[Int]] -> [[Int]]
go ([Int]
xforall a. a -> [a] -> [a]
:[[Int]]
keep) [[Int]]
xs
>           go [[Int]]
keep [[Int]]
_ = forall a. [a] -> [a]
reverse [[Int]]
keep

There is almost certainly a more efficient procedure
for basis-extraction that makes use of the J-order.
What it might be is a question for later.


Helper Functions
================

> backpermute :: [Int] -> [Int] -> [Int]
> backpermute :: [Int] -> [Int] -> [Int]
backpermute = forall a. a -> [a] -> [Int] -> [a]
backpermuteDef (-Int
1)

The call 'backpermute xs is' is equivalent to grabbing the elements
of xs at the given indices 'map (flip (atDef (-1)) xs) is';
however, on lists the lookup is a linear-time operation,
so doing it n times becomes quadratic.
We can improve this by first doing an nlgn sort
to get the indices in order.
Then one single linear scan will suffice to extract the elements,
and we can sort again to put things where they belong.

> backpermuteDef  :: a -> [a] -> [Int] -> [a]
> backpermuteDef :: forall a. a -> [a] -> [Int] -> [a]
backpermuteDef a
a [a]
xs = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> b
snd)
>                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. [a] -> [(Int, b)] -> [(a, b)]
extract [a]
xs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b}. Num a => [(a, b)] -> [(a, b)]
deltas forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int
0,Int
0)forall a. a -> [a] -> [a]
:)
>                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0::Int ..]
>     where deltas :: [(a, b)] -> [(a, b)]
deltas ((a, b)
x:(a, b)
y:[(a, b)]
ys) = (forall a b. (a, b) -> a
fst (a, b)
y forall a. Num a => a -> a -> a
- forall a b. (a, b) -> a
fst (a, b)
x, forall a b. (a, b) -> b
snd (a, b)
y) forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)]
deltas ((a, b)
yforall a. a -> [a] -> [a]
:[(a, b)]
ys)
>           deltas [(a, b)]
_ = []
>           extract :: [a] -> [(Int, b)] -> [(a, b)]
extract [a]
ys ((Int, b)
p:[(Int, b)]
ps) = b -> [a] -> [(Int, b)] -> [(a, b)]
grab (forall a b. (a, b) -> b
snd (Int, b)
p) (forall a. Int -> [a] -> [a]
drop (forall a b. (a, b) -> a
fst (Int, b)
p) [a]
ys) [(Int, b)]
ps
>           extract [a]
_ [(Int, b)]
_ = []
>           grab :: b -> [a] -> [(Int, b)] -> [(a, b)]
grab b
i [a]
ys [(Int, b)]
ns = case [a]
ys of
>                            (a
y:[a]
_) -> ( a
y,b
i) forall a. a -> [a] -> [a]
: [a] -> [(Int, b)] -> [(a, b)]
extract [a]
ys [(Int, b)]
ns
>                            [a]
_     -> ( a
a,b
i) forall a. a -> [a] -> [a]
: [a] -> [(Int, b)] -> [(a, b)]
extract [a]
ys [(Int, b)]
ns

> equal :: Eq b => (a -> b) -> a -> a -> Bool
> equal :: forall b a. Eq b => (a -> b) -> a -> a -> Bool
equal a -> b
f a
x a
y = a -> b
f a
x forall a. Eq a => a -> a -> Bool
== a -> b
f a
y

> -- |Internal, not for export.
> -- Return a multiplication table by extracting rows and columns
> -- from a larger multiplication table and renaming elements.
> restrict :: FSMult -> [Int] -> FSMult
> restrict :: FSMult -> [Int] -> FSMult
restrict FSMult
t [Int]
xs
>     = [[Int]] -> FSMult
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-Int
1) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [Int]
xs))
>       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip [Int] -> [Int] -> [Int]
backpermute [Int]
xs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. a -> [a] -> [Int] -> [a]
backpermuteDef []) [Int]
xs
>       forall a b. (a -> b) -> a -> b
$ FSMult -> [[Int]]
getTable FSMult
t
>     where f :: [[Int]] -> FSMult
f [[Int]]
m = Int -> [[Int]] -> FSMult
FSMult (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Int]]
m) [[Int]]
m


I/O
===

> -- |From the documentation: precedence of function application is 10
> app_prec :: Int
> app_prec :: Int
app_prec = Int
10

> instance Show GeneratedAction where
>     showsPrec :: Int -> GeneratedAction -> ShowS
showsPrec Int
d GeneratedAction
ga
>         = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
app_prec) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"fromBases "
>           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec (Int
app_prec forall a. Num a => a -> a -> a
+ Int
1) (GeneratedAction -> [[Int]]
bases GeneratedAction
ga)
> instance Read GeneratedAction where
>     readsPrec :: Int -> ReadS GeneratedAction
readsPrec Int
d String
r
>         = forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
app_prec)
>           (\String
x -> [ ([[Int]] -> GeneratedAction
fromBases [[Int]]
bs, String
t)
>                  | (String
"fromBases",String
s) <- ReadS String
lex String
x
>                  , ([[Int]]
bs,String
t) <- forall a. Read a => Int -> ReadS a
readsPrec (Int
app_prec forall a. Num a => a -> a -> a
+ Int
1) String
s]) String
r

We do not want people giving us arbitrary tables
which might not be associative.
But we really do want to be able to see things.
And since Show/Read are supposed to be inverses,
let's make it happen: go via fromBases and all will be fine.

> instance Show FSMult where
>     showsPrec :: Int -> FSMult -> ShowS
showsPrec Int
d FSMult
mt
>         = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
app_prec)
>           forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"fstable "
>           forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( Bool -> ShowS -> ShowS
showParen Bool
True
>             forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"fromBases " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec (Int
app_prec forall a. Num a => a -> a -> a
+ Int
1) [[Int]]
bs)
>         where bs :: [[Int]]
bs = forall a. Int -> [a] -> [a]
take (FSMult -> Int
basisRows FSMult
mt) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSMult -> [[Int]]
getTable
>                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FiniteSemigroupRep a => a -> FSMult
adjoinOne forall a b. (a -> b) -> a -> b
$ forall a. FiniteSemigroupRep a => a -> FSMult
dual FSMult
mt
> instance Read FSMult where
>     readsPrec :: Int -> ReadS FSMult
readsPrec Int
d String
r
>         = forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
app_prec)
>           (\String
x -> [ (forall a. FiniteSemigroupRep a => a -> FSMult
fstable (GeneratedAction
bs :: GeneratedAction), String
t)
>                  | (String
"fstable",String
s) <- ReadS String
lex String
x
>                  , (GeneratedAction
bs,String
t) <- forall a. Read a => Int -> ReadS a
readsPrec (Int
app_prec forall a. Num a => a -> a -> a
+ Int
1) String
s]) String
r