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

> This module implements an algorithm to decide whether a given FSA
> is generalized locally testable in the sense of Brzozowski and
> Fich (1984):
> https://doi.org/10.1016/0012-365X(84)90045-1
>
> @since 1.0
> -}
> module LTK.Decide.GLT (isGLT, isGLTM, isGLTs) where

> import Data.Representation.FiniteSemigroup

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

> -- |True iff the automaton recognizes a generalized locally-testable
> -- stringset.
> isGLT :: (Ord n, Ord e) => FSA n e -> Bool
> isGLT :: forall n e. (Ord n, Ord e) => FSA n e -> Bool
isGLT = GeneratedAction -> Bool
forall s. FiniteSemigroupRep s => s -> Bool
isGLTs (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 satisfies the generalized local testabiltiy
> -- condition.
> isGLTM :: (Ord n, Ord e) => SynMon n e -> Bool
> isGLTM :: forall n e. (Ord n, Ord e) => SynMon n e -> Bool
isGLTM = FSA ([Maybe n], [Symbol e]) e -> Bool
forall n e. (Ord n, Ord e) => FSA n e -> Bool
isGLT

> -- |True iff the semigroup lies in \(M_e J_1\).
> --
> -- @since 1.2
> isGLTs :: FiniteSemigroupRep s => s -> Bool
> isGLTs :: forall s. FiniteSemigroupRep s => s -> Bool
isGLTs = (FSMult -> Bool) -> [FSMult] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((FSMult -> Bool) -> (FSMult -> Bool) -> FSMult -> Bool
forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
both FSMult -> Bool
forall s. FiniteSemigroupRep s => s -> Bool
isJTrivial FSMult -> Bool
forall s. FiniteSemigroupRep s => s -> Bool
isBand) ([FSMult] -> Bool) -> (s -> [FSMult]) -> s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> [FSMult]
forall s. FiniteSemigroupRep s => s -> [FSMult]
emee