> {-# OPTIONS_HADDOCK show-extensions #-}
>
> 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
>
>
>
> 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
>
> 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.
>
> 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)
>
>
>
> 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
>
>
>
>
> 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
>
>
> 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
>
> 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)
>
>
> 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
>
> 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
>
>
> 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
>
>
>
> 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