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

> This module provides classification algorithms for finite semigroups.
> -}

> module Data.Representation.FiniteSemigroup.Classification
>     ( isAperiodic
>     , isBand
>     , isCommutative
>     , isDA
>     , isJTrivial
>     , isLTrivial
>     , isNilpotent
>     , isRTrivial
>     , isTrivial
>     , locally
>     ) where

> import Data.Representation.FiniteSemigroup.Base

> import qualified Data.IntSet as IntSet
> import Data.List (intersect, sort, transpose)
> import qualified Data.List.NonEmpty as NE


> -- |True if and only if all subgroups are trivial.
> -- That is, no two distinct elements
> -- are both \(\mathcal{L}\)-related and \(\mathcal{R}\)-related.
> isAperiodic :: FiniteSemigroupRep s => s -> Bool
> isAperiodic :: forall s. FiniteSemigroupRep s => s -> Bool
isAperiodic = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. FiniteSemigroupRep s => s -> [Int]
groupSizes

> -- |True if and only if all elements are idempotent.
> isBand :: FiniteSemigroupRep s => s -> Bool
> isBand :: forall s. FiniteSemigroupRep s => s -> Bool
isBand = forall b a. Eq b => (a -> b) -> (a -> b) -> a -> Bool
same (IntSet -> Int
IntSet.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. FiniteSemigroupRep s => s -> IntSet
idempotents) forall a. FiniteSemigroupRep a => a -> Int
fssize

For commutativity: only the bases need to be checked.

> -- |True if and only if \(xy=yx\) for all \(x\) and \(y\).
> isCommutative :: FiniteSemigroupRep s => s -> Bool
> isCommutative :: forall s. FiniteSemigroupRep s => s -> Bool
isCommutative s
s = forall b a. Eq b => (a -> b) -> (a -> b) -> a -> Bool
same (forall {a}. [a] -> [a]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
transpose) forall {a}. [a] -> [a]
bs 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 bs :: [a] -> [a]
bs = forall a. Int -> [a] -> [a]
take (forall a. FiniteSemigroupRep a => a -> Int
fsnbases s
s)

> -- |True if and only if all regular \(\mathcal{D}\)-classes
> -- are aperiodic semigroups.
> -- Equivalently: all regular elements are idempotent.
> isDA :: FiniteSemigroupRep s => s -> Bool
> isDA :: forall s. FiniteSemigroupRep s => s -> Bool
isDA s
s = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any NonEmpty Int -> Bool
mixed forall a b. (a -> b) -> a -> b
$ forall s. FiniteSemigroupRep s => s -> [NonEmpty Int]
rClasses FSMult
t
>     where t :: FSMult
t = forall a. FiniteSemigroupRep a => a -> FSMult
fstable s
s
>           is :: IntSet
is = forall s. FiniteSemigroupRep s => s -> IntSet
idempotents FSMult
t
>           mixed :: NonEmpty Int -> Bool
mixed (Int
x NE.:| [Int]
xs)
>               | Int
x Int -> IntSet -> Bool
`IntSet.member` IntSet
is = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> IntSet -> Bool
`IntSet.notMember` IntSet
is) [Int]
xs
>               | Bool
otherwise            = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> IntSet -> Bool
`IntSet.member` IntSet
is) [Int]
xs

> -- |True if and only if no two distinct elements
> -- are \(\mathcal{J}\)-related.
> -- Equivalently:
> -- both \(\mathcal{L}\)-trivial and \(\mathcal{R}\)-trivial.
> isJTrivial :: FiniteSemigroupRep s => s -> Bool
> isJTrivial :: forall s. FiniteSemigroupRep s => s -> Bool
isJTrivial = forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
both forall s. FiniteSemigroupRep s => s -> Bool
isRTrivial forall s. FiniteSemigroupRep s => s -> Bool
isLTrivial

> -- |True if and only if no two distinct elements
> -- are \(\mathcal{L}\)-related.
> isLTrivial :: FiniteSemigroupRep s => s -> Bool
> isLTrivial :: forall s. FiniteSemigroupRep s => s -> Bool
isLTrivial = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.tail) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. FiniteSemigroupRep s => s -> [NonEmpty Int]
lClasses

> -- |True if and only if the only idempotent element is zero.
> isNilpotent :: FiniteSemigroupRep s => s -> Bool
> isNilpotent :: forall s. FiniteSemigroupRep s => s -> Bool
isNilpotent = forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
both forall s. FiniteSemigroupRep s => s -> Bool
isRTrivial ((forall a. Eq a => a -> a -> Bool
== Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Int
IntSet.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. FiniteSemigroupRep s => s -> IntSet
idempotents)

> -- |True if and only if no two distinct elements
> -- are \(\mathcal{L}\)-related.
> isRTrivial :: FiniteSemigroupRep s => s -> Bool
> isRTrivial :: forall s. FiniteSemigroupRep s => s -> Bool
isRTrivial = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.tail) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. FiniteSemigroupRep s => s -> [NonEmpty Int]
rClasses

> -- |True if and only if there is but a single element.
> isTrivial :: FiniteSemigroupRep s => s -> Bool
> isTrivial :: forall s. FiniteSemigroupRep s => s -> Bool
isTrivial = (forall a. Ord a => a -> a -> Bool
<Int
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FiniteSemigroupRep a => a -> Int
fssize

> -- |True if and only if each of the 'localSubmonoids'
> -- satisfies the given proposition.
> locally :: FiniteSemigroupRep s => (FSMult -> Bool) -> s -> Bool
> locally :: forall s. FiniteSemigroupRep s => (FSMult -> Bool) -> s -> Bool
locally FSMult -> Bool
f = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all FSMult -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. FiniteSemigroupRep s => s -> [FSMult]
localSubmonoids


> -- |For each \(\mathcal{D}\)-class,
> -- yields an integer describing how many elements
> -- are in each group within that class.
> groupSizes :: FiniteSemigroupRep s => s -> [Int]
> groupSizes :: forall s. FiniteSemigroupRep s => s -> [Int]
groupSizes s
s = 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
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) 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 a. Eq a => [a] -> [a] -> [a]
intersect)
>                forall a b. (a -> b) -> a -> b
$ forall c a b.
Ord c =>
(a -> a -> b) -> (a -> c) -> [a] -> [a] -> [b]
mergeEmitBy forall {a} {a}. NonEmpty a -> NonEmpty a -> ([a], [a])
f forall a. NonEmpty a -> a
NE.head [NonEmpty Int]
rc [NonEmpty Int]
lc
>     where t :: FSMult
t = forall a. FiniteSemigroupRep a => a -> FSMult
fstable s
s
>           rc :: [NonEmpty Int]
rc = forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall s. FiniteSemigroupRep s => s -> [NonEmpty Int]
rClasses FSMult
t
>           lc :: [NonEmpty Int]
lc = forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall s. FiniteSemigroupRep s => s -> [NonEmpty Int]
lClasses FSMult
t
>           f :: NonEmpty a -> NonEmpty a -> ([a], [a])
f NonEmpty a
x NonEmpty a
y = (forall a. NonEmpty a -> [a]
NE.tail NonEmpty a
x, forall a. NonEmpty a -> [a]
NE.tail NonEmpty a
y)


> mergeEmitBy :: Ord c => (a -> a -> b) -> (a -> c) -> [a] -> [a] -> [b]
> mergeEmitBy :: forall c a b.
Ord c =>
(a -> a -> b) -> (a -> c) -> [a] -> [a] -> [b]
mergeEmitBy a -> a -> b
_ a -> c
_ [] [a]
_ = []
> mergeEmitBy a -> a -> b
_ a -> c
_ [a]
_ [] = []
> mergeEmitBy a -> a -> b
emit a -> c
by (a
x:[a]
xs) (a
y:[a]
ys)
>     = case forall a. Ord a => a -> a -> Ordering
compare (a -> c
by a
x) (a -> c
by a
y) of
>         Ordering
EQ -> a -> a -> b
emit a
x a
y forall a. a -> [a] -> [a]
: forall c a b.
Ord c =>
(a -> a -> b) -> (a -> c) -> [a] -> [a] -> [b]
mergeEmitBy a -> a -> b
emit a -> c
by [a]
xs [a]
ys
>         Ordering
LT -> forall c a b.
Ord c =>
(a -> a -> b) -> (a -> c) -> [a] -> [a] -> [b]
mergeEmitBy a -> a -> b
emit a -> c
by [a]
xs (a
yforall a. a -> [a] -> [a]
:[a]
ys)
>         Ordering
GT -> forall c a b.
Ord c =>
(a -> a -> b) -> (a -> c) -> [a] -> [a] -> [b]
mergeEmitBy a -> a -> b
emit a -> c
by (a
xforall a. a -> [a] -> [a]
:[a]
xs) [a]
ys

> same :: Eq b => (a -> b) -> (a -> b) -> a -> Bool
> same :: forall b a. Eq b => (a -> b) -> (a -> b) -> a -> Bool
same a -> b
f a -> b
g a
a = a -> b
f a
a forall a. Eq a => a -> a -> Bool
== a -> b
g a
a

> both :: (a -> Bool) -> (a -> Bool) -> a -> Bool
> both :: forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
both a -> Bool
f a -> Bool
g a
a = a -> Bool
f a
a Bool -> Bool -> Bool
&& a -> Bool
g a
a