> {-# OPTIONS_HADDOCK show-extensions #-}
> {-|
> Module    : LTK.Decide.LTT
> Copyright : (c) 2019,2021-2024 Dakotah Lambert
> License   : MIT

> This module implements an algorithm to decide whether a given FSA
> is Locally Testable (LTT) based on the semigroup characterization
> of Beaquier and Pin from their 1989 work
> "Factors of Words".
>
> @since 0.2
> -}
> module LTK.Decide.LTT (isLTT, isLTTM, isLTTs) where

> import Data.Representation.FiniteSemigroup
> import qualified Data.IntSet as IntSet

> import LTK.FSA
> import LTK.Algebra(SynMon)

> -- |True iff the automaton recognizes an LTT stringset.
> isLTT :: (Ord n, Ord e) => FSA n e -> Bool
> isLTT :: forall n e. (Ord n, Ord e) => FSA n e -> Bool
isLTT = GeneratedAction -> Bool
forall s. FiniteSemigroupRep s => s -> Bool
isLTTs (GeneratedAction -> Bool)
-> (FSA n e -> GeneratedAction) -> FSA n e -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA n e -> GeneratedAction
forall n e. (Ord n, Ord e) => FSA n e -> GeneratedAction
syntacticSemigroup

> -- |True iff the monoid recognizes an LTT stringset.
> --
> -- @since 1.0
> isLTTM :: (Ord n, Ord e) => SynMon n e -> Bool
> isLTTM :: forall n e. (Ord n, Ord e) => SynMon n e -> Bool
isLTTM = FSA ([Maybe n], [Symbol e]) e -> Bool
forall n e. (Ord n, Ord e) => FSA n e -> Bool
isLTT

A semigroup (S) [e.g. the syntactic semigroup] is
locally threshold testable iff
for all idempotent e and f, and for all a,b,u it holds that
eafuebf = ebfueaf.

> -- |True iff the semigroup recognizes an LTT stringset.
> --
> -- @since 1.2
> isLTTs :: FiniteSemigroupRep s => s -> Bool
> isLTTs :: forall s. FiniteSemigroupRep s => s -> Bool
isLTTs s
s = s -> Bool
forall s. FiniteSemigroupRep s => s -> Bool
isAperiodic s
s Bool -> Bool -> Bool
&& ((Int, Int) -> Bool) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool) -> (Int, Int) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Bool
go) [(Int
a,Int
b) | Int
a <- [Int]
is, Int
b <- [Int]
is]
>     where t :: FSMult
t = s -> FSMult
forall a. FiniteSemigroupRep a => a -> FSMult
fstable s
s
>           is :: [Int]
is = IntSet -> [Int]
IntSet.toList (IntSet -> [Int]) -> IntSet -> [Int]
forall a b. (a -> b) -> a -> b
$ FSMult -> IntSet
forall s. FiniteSemigroupRep s => s -> IntSet
idempotents FSMult
t
>           xs :: [Int]
xs = [Int
0..FSMult -> Int
forall a. FiniteSemigroupRep a => a -> Int
fssize FSMult
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
>           eval :: [Int] -> Int
eval = (Int -> Int -> Int) -> [Int] -> Int
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (FSMult -> Int -> Int -> Int
forall a. FiniteSemigroupRep a => a -> Int -> Int -> Int
fsappend FSMult
t)
>           go :: Int -> Int -> Bool
go Int
e Int
f = let ps :: [Int]
ps = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> [Int] -> Int
eval [Int
e,Int
i,Int
f]) [Int]
xs
>                    in ((Int, Int) -> Bool) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool) -> (Int, Int) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Bool
check) [(Int
a,Int
b) | Int
a <- [Int]
ps, Int
b <- [Int]
ps]
>           check :: Int -> Int -> Bool
check Int
a Int
b = (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
i -> [Int] -> Int
eval [Int
a,Int
i,Int
b] Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Int] -> Int
eval [Int
b,Int
i,Int
a]) [Int]
xs