> {-# OPTIONS_HADDOCK show-extensions #-}
> {-|
> Module    : LTK.Parameters
> Copyright : (c) 2023-2024 Dakotah Lambert
> License   : MIT
> 
> Many subregular classes are parameterized.
> In some cases, we know not only how to decide membership,
> but also the values of these parameters.
> As a general interface, each parameterization function
> returns a @Maybe [Parameter e]@,
> where @Nothing@ means the language is not in the class
> and @Just xs@ indicates for which parameters this membership holds.
> The interpretation of the list differs per class;
> consult the individual functions' documentation for more information.
>
> All arguments should be given in minimal form.
> This is never checked.
>
> @since 1.2
> -}
> module LTK.Parameters ( Parameter(..)
>                       , pTier
>                       , pDef, pRDef, pGDef
>                       , pCB, pAcom
>                       , pSL, pSP
>                       ) where

> import Data.Representation.FiniteSemigroup
> import Data.Set (Set)
> import qualified Data.IntSet as IntSet
> import qualified Data.Set as Set

> import LTK.FSA
> import LTK.Decide
> import LTK.Extract.SL (slQ)
> import LTK.Tiers (project, tier)

> -- |A named parameter.
> data Parameter e = PInt String Int
>                  | PSymSet String (Set e)
>                    deriving (Parameter e -> Parameter e -> Bool
(Parameter e -> Parameter e -> Bool)
-> (Parameter e -> Parameter e -> Bool) -> Eq (Parameter e)
forall e. Eq e => Parameter e -> Parameter e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => Parameter e -> Parameter e -> Bool
== :: Parameter e -> Parameter e -> Bool
$c/= :: forall e. Eq e => Parameter e -> Parameter e -> Bool
/= :: Parameter e -> Parameter e -> Bool
Eq, Eq (Parameter e)
Eq (Parameter e) =>
(Parameter e -> Parameter e -> Ordering)
-> (Parameter e -> Parameter e -> Bool)
-> (Parameter e -> Parameter e -> Bool)
-> (Parameter e -> Parameter e -> Bool)
-> (Parameter e -> Parameter e -> Bool)
-> (Parameter e -> Parameter e -> Parameter e)
-> (Parameter e -> Parameter e -> Parameter e)
-> Ord (Parameter e)
Parameter e -> Parameter e -> Bool
Parameter e -> Parameter e -> Ordering
Parameter e -> Parameter e -> Parameter e
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
forall e. Ord e => Eq (Parameter e)
forall e. Ord e => Parameter e -> Parameter e -> Bool
forall e. Ord e => Parameter e -> Parameter e -> Ordering
forall e. Ord e => Parameter e -> Parameter e -> Parameter e
$ccompare :: forall e. Ord e => Parameter e -> Parameter e -> Ordering
compare :: Parameter e -> Parameter e -> Ordering
$c< :: forall e. Ord e => Parameter e -> Parameter e -> Bool
< :: Parameter e -> Parameter e -> Bool
$c<= :: forall e. Ord e => Parameter e -> Parameter e -> Bool
<= :: Parameter e -> Parameter e -> Bool
$c> :: forall e. Ord e => Parameter e -> Parameter e -> Bool
> :: Parameter e -> Parameter e -> Bool
$c>= :: forall e. Ord e => Parameter e -> Parameter e -> Bool
>= :: Parameter e -> Parameter e -> Bool
$cmax :: forall e. Ord e => Parameter e -> Parameter e -> Parameter e
max :: Parameter e -> Parameter e -> Parameter e
$cmin :: forall e. Ord e => Parameter e -> Parameter e -> Parameter e
min :: Parameter e -> Parameter e -> Parameter e
Ord, ReadPrec [Parameter e]
ReadPrec (Parameter e)
Int -> ReadS (Parameter e)
ReadS [Parameter e]
(Int -> ReadS (Parameter e))
-> ReadS [Parameter e]
-> ReadPrec (Parameter e)
-> ReadPrec [Parameter e]
-> Read (Parameter e)
forall e. (Read e, Ord e) => ReadPrec [Parameter e]
forall e. (Read e, Ord e) => ReadPrec (Parameter e)
forall e. (Read e, Ord e) => Int -> ReadS (Parameter e)
forall e. (Read e, Ord e) => ReadS [Parameter e]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall e. (Read e, Ord e) => Int -> ReadS (Parameter e)
readsPrec :: Int -> ReadS (Parameter e)
$creadList :: forall e. (Read e, Ord e) => ReadS [Parameter e]
readList :: ReadS [Parameter e]
$creadPrec :: forall e. (Read e, Ord e) => ReadPrec (Parameter e)
readPrec :: ReadPrec (Parameter e)
$creadListPrec :: forall e. (Read e, Ord e) => ReadPrec [Parameter e]
readListPrec :: ReadPrec [Parameter e]
Read, Int -> Parameter e -> ShowS
[Parameter e] -> ShowS
Parameter e -> String
(Int -> Parameter e -> ShowS)
-> (Parameter e -> String)
-> ([Parameter e] -> ShowS)
-> Show (Parameter e)
forall e. Show e => Int -> Parameter e -> ShowS
forall e. Show e => [Parameter e] -> ShowS
forall e. Show e => Parameter e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> Parameter e -> ShowS
showsPrec :: Int -> Parameter e -> ShowS
$cshow :: forall e. Show e => Parameter e -> String
show :: Parameter e -> String
$cshowList :: forall e. Show e => [Parameter e] -> ShowS
showList :: [Parameter e] -> ShowS
Show)

> -- |If there are neutral symbols, test a class
> -- and prepend to its parameters the set of salient symbols.
> pTier :: (Ord n, Ord e) => (FSA n e -> Maybe [Parameter e])
>       -> FSA n e -> Maybe [Parameter e]
> pTier :: forall n e.
(Ord n, Ord e) =>
(FSA n e -> Maybe [Parameter e]) -> FSA n e -> Maybe [Parameter e]
pTier FSA n e -> Maybe [Parameter e]
pX FSA n e
f = (String -> Set e -> Parameter e
forall e. String -> Set e -> Parameter e
PSymSet String
"T" (FSA n e -> Set e
forall n e. (Ord n, Ord e) => FSA n e -> Set e
tier FSA n e
f) Parameter e -> [Parameter e] -> [Parameter e]
forall a. a -> [a] -> [a]
:) ([Parameter e] -> [Parameter e])
-> Maybe [Parameter e] -> Maybe [Parameter e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FSA n e -> Maybe [Parameter e]
pX (FSA n e -> FSA n e
forall n e. (Ord n, Ord e) => FSA n e -> FSA n e
project FSA n e
f)

> -- |Returns an empty parameter list.
> pCB :: (Ord n, Ord e) => FSA n e -> Maybe [Parameter e]
> pCB :: forall n e. (Ord n, Ord e) => FSA n e -> Maybe [Parameter e]
pCB = (FSA n e -> [Parameter e])
-> Maybe (FSA n e) -> Maybe [Parameter e]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Parameter e] -> FSA n e -> [Parameter e]
forall a b. a -> b -> a
const []) (Maybe (FSA n e) -> Maybe [Parameter e])
-> (FSA n e -> Maybe (FSA n e)) -> FSA n e -> Maybe [Parameter e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FSA n e -> Bool) -> FSA n e -> Maybe (FSA n e)
forall a. (a -> Bool) -> a -> Maybe a
predicated FSA n e -> Bool
forall n e. (Ord n, Ord e) => FSA n e -> Bool
isCB

I am confident that all of the below are out there in the literature.
But it's very hard to search for these things.
So, no citations, sorry, I had to figure them out on my own.

> -- |Return the length of the longest relevant suffix.
> pDef :: (Ord n, Ord e) => FSA n e -> Maybe [Parameter e]
> pDef :: forall n e. (Ord n, Ord e) => FSA n e -> Maybe [Parameter e]
pDef  = (FSA n e -> [Parameter e])
-> Maybe (FSA n e) -> Maybe [Parameter e]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Int -> [Parameter e]
forall e. String -> Int -> [Parameter e]
wrap String
"k" (Int -> [Parameter e])
-> (FSA n e -> Int) -> FSA n e -> [Parameter e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> (FSA n e -> Int) -> FSA n e -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA n e -> Int
forall n e. (Ord n, Ord e) => FSA n e -> Int
rchain) (Maybe (FSA n e) -> Maybe [Parameter e])
-> (FSA n e -> Maybe (FSA n e)) -> FSA n e -> Maybe [Parameter e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FSA n e -> Bool) -> FSA n e -> Maybe (FSA n e)
forall a. (a -> Bool) -> a -> Maybe a
predicated FSA n e -> Bool
forall n e. (Ord n, Ord e) => FSA n e -> Bool
isDef
> -- |Return the length of the longest relevant prefix.
> pRDef :: (Ord n, Ord e) => FSA n e -> Maybe [Parameter e]
> pRDef :: forall n e. (Ord n, Ord e) => FSA n e -> Maybe [Parameter e]
pRDef = (FSA n e -> [Parameter e])
-> Maybe (FSA n e) -> Maybe [Parameter e]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Int -> [Parameter e]
forall e. String -> Int -> [Parameter e]
wrap String
"k" (Int -> [Parameter e])
-> (FSA n e -> Int) -> FSA n e -> [Parameter e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> (FSA n e -> Int) -> FSA n e -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA n e -> Int
forall n e. (Ord n, Ord e) => FSA n e -> Int
rchain) (Maybe (FSA n e) -> Maybe [Parameter e])
-> (FSA n e -> Maybe (FSA n e)) -> FSA n e -> Maybe [Parameter e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FSA n e -> Bool) -> FSA n e -> Maybe (FSA n e)
forall a. (a -> Bool) -> a -> Maybe a
predicated FSA n e -> Bool
forall n e. (Ord n, Ord e) => FSA n e -> Bool
isRDef
> -- |Return the length of the longest relevant suffix or prefix,
> -- whichever is longer.
> pGDef :: (Ord n, Ord e) => FSA n e -> Maybe [Parameter e]
> pGDef :: forall n e. (Ord n, Ord e) => FSA n e -> Maybe [Parameter e]
pGDef = (FSA n e -> [Parameter e])
-> Maybe (FSA n e) -> Maybe [Parameter e]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Int -> [Parameter e]
forall e. String -> Int -> [Parameter e]
wrap String
"k" (Int -> [Parameter e])
-> (FSA n e -> Int) -> FSA n e -> [Parameter e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> (FSA n e -> Int) -> FSA n e -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA n e -> Int
forall n e. (Ord n, Ord e) => FSA n e -> Int
rchain) (Maybe (FSA n e) -> Maybe [Parameter e])
-> (FSA n e -> Maybe (FSA n e)) -> FSA n e -> Maybe [Parameter e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FSA n e -> Bool) -> FSA n e -> Maybe (FSA n e)
forall a. (a -> Bool) -> a -> Maybe a
predicated FSA n e -> Bool
forall n e. (Ord n, Ord e) => FSA n e -> Bool
isGD

> -- |Return the threshold at which symbol counting saturates.
> pAcom :: (Ord n, Ord e) => FSA n e -> Maybe [Parameter e]
> pAcom :: forall n e. (Ord n, Ord e) => FSA n e -> Maybe [Parameter e]
pAcom FSA n e
f = (FSA n e -> [Parameter e])
-> Maybe (FSA n e) -> Maybe [Parameter e]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Parameter e] -> FSA n e -> [Parameter e]
forall a b. a -> b -> a
const (String -> Int -> [Parameter e]
forall e. String -> Int -> [Parameter e]
wrap String
"t" Int
m)) (Maybe (FSA n e) -> Maybe [Parameter e])
-> Maybe (FSA n e) -> Maybe [Parameter e]
forall a b. (a -> b) -> a -> b
$ (FSA n e -> Bool) -> FSA n e -> Maybe (FSA n e)
forall a. (a -> Bool) -> a -> Maybe a
predicated FSA n e -> Bool
forall n e. (Ord n, Ord e) => FSA n e -> Bool
isAcom FSA n e
f
>     where s :: GeneratedAction
s = FSA n e -> GeneratedAction
forall n e. (Ord n, Ord e) => FSA n e -> GeneratedAction
syntacticSemigroup FSA n e
f
>           sz :: Int -> Int
sz = IntSet -> Int
IntSet.size (IntSet -> Int) -> (Int -> IntSet) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneratedAction -> IntSet -> IntSet
forall s. FiniteSemigroupRep s => s -> IntSet -> IntSet
subsemigroup GeneratedAction
s (IntSet -> IntSet) -> (Int -> IntSet) -> Int -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntSet
IntSet.singleton
>           m :: Int
m = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
sz [Int
0 .. GeneratedAction -> Int
forall a. FiniteSemigroupRep a => a -> Int
fsnbases GeneratedAction
s]

SP is my own algorithm,
explained in "Extracting subregular constraints from regular stringsets"
(https://doi.org/10.15398/jlm.v7i2.209).
I do not believe the parameter-finding is explicitly discussed,
but it follows from the extraction procedure.

> -- |Return the length of the longest relevant subsequence.
> pSP :: (Ord n, Ord e) => FSA n e -> Maybe [Parameter e]
> pSP :: forall n e. (Ord n, Ord e) => FSA n e -> Maybe [Parameter e]
pSP = (FSA n e -> [Parameter e])
-> Maybe (FSA n e) -> Maybe [Parameter e]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Int -> [Parameter e]
forall e. String -> Int -> [Parameter e]
wrap String
"k" (Int -> [Parameter e])
-> (FSA n e -> Int) -> FSA n e -> [Parameter e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (FSA n e -> Int) -> FSA n e -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA n () -> Int
forall n. Ord n => FSA n () -> Int
dagHeight (FSA n () -> Int) -> (FSA n e -> FSA n ()) -> FSA n e -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA n e -> FSA n ()
simplify) (Maybe (FSA n e) -> Maybe [Parameter e])
-> (FSA n e -> Maybe (FSA n e)) -> FSA n e -> Maybe [Parameter e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FSA n e -> Bool) -> FSA n e -> Maybe (FSA n e)
forall a. (a -> Bool) -> a -> Maybe a
predicated FSA n e -> Bool
forall n e. (Ord n, Ord e) => FSA n e -> Bool
isSP
>     where deloop :: FSA n e -> FSA n e
deloop FSA n e
f = FSA n e
f { transitions
>                              = Set.filter
>                                (\Transition n e
t -> Transition n e -> State n
forall n e. Transition n e -> State n
source Transition n e
t State n -> State n -> Bool
forall a. Eq a => a -> a -> Bool
/= Transition n e -> State n
forall n e. Transition n e -> State n
destination Transition n e
t)
>                                (transitions f)
>                        }
>           simplify :: FSA n e -> FSA n ()
simplify = FSA n () -> FSA n ()
forall {n} {e}. Eq n => FSA n e -> FSA n e
deloop (FSA n () -> FSA n ())
-> (FSA n e -> FSA n ()) -> FSA n e -> FSA n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> ()) -> FSA n e -> FSA n ()
forall e e1 n.
(Ord e, Ord e1, Ord n) =>
(e -> e1) -> FSA n e -> FSA n e1
renameSymbolsBy (() -> e -> ()
forall a b. a -> b -> a
const ())

The SL algorithm is explained in the same paper as the SP one,
and is actually how we check for SL membership in the first place.

> -- |Return the length of the longest relevant substring.
> pSL :: (Ord n, Ord e) => FSA n e -> Maybe [Parameter e]
> pSL :: forall n e. (Ord n, Ord e) => FSA n e -> Maybe [Parameter e]
pSL = (Integer -> [Parameter e]) -> Maybe Integer -> Maybe [Parameter e]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Int -> [Parameter e]
forall e. String -> Int -> [Parameter e]
wrap String
"k" (Int -> [Parameter e])
-> (Integer -> Int) -> Integer -> [Parameter e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Maybe Integer -> Maybe [Parameter e])
-> (FSA n e -> Maybe Integer) -> FSA n e -> Maybe [Parameter e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Bool) -> Integer -> Maybe Integer
forall a. (a -> Bool) -> a -> Maybe a
predicated (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0)
>       (Integer -> Maybe Integer)
-> (FSA n e -> Integer) -> FSA n e -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA Integer e -> Integer
forall e n. (Ord e, Ord n) => FSA n e -> Integer
slQ (FSA Integer e -> Integer)
-> (FSA n e -> FSA Integer e) -> FSA n e -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA n e -> FSA Integer e
forall e n. (Ord e, Ord n) => FSA n e -> FSA Integer e
normalize


Helpers
=======

> wrap :: String -> Int -> [Parameter e]
> wrap :: forall e. String -> Int -> [Parameter e]
wrap String
s = Parameter e -> [Parameter e]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parameter e -> [Parameter e])
-> (Int -> Parameter e) -> Int -> [Parameter e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> Parameter e
forall e. String -> Int -> Parameter e
PInt String
s

> predicated :: (a -> Bool) -> a -> Maybe a
> predicated :: forall a. (a -> Bool) -> a -> Maybe a
predicated a -> Bool
p a
x = if a -> Bool
p a
x then a -> Maybe a
forall a. a -> Maybe a
Just a
x else Maybe a
forall a. Maybe a
Nothing

> -- |Return the length of the longest (strictly) ascending R-chain
> -- in the syntactic monoid, in terms of the number of elements.
> rchain :: (Ord n, Ord e) => FSA n e -> Int
> rchain :: forall n e. (Ord n, Ord e) => FSA n e -> Int
rchain = Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (FSA n e -> Int) -> FSA n e -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA (Set ([Maybe n], [Symbol e])) () -> Int
forall n. Ord n => FSA n () -> Int
dagHeight (FSA (Set ([Maybe n], [Symbol e])) () -> Int)
-> (FSA n e -> FSA (Set ([Maybe n], [Symbol e])) ())
-> FSA n e
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA ([Maybe n], [Symbol e]) ()
-> FSA (Set ([Maybe n], [Symbol e])) ()
forall n e. (Ord n, Ord e) => FSA n e -> FSA (Set n) ()
sccGraph (FSA ([Maybe n], [Symbol e]) ()
 -> FSA (Set ([Maybe n], [Symbol e])) ())
-> (FSA n e -> FSA ([Maybe n], [Symbol e]) ())
-> FSA n e
-> FSA (Set ([Maybe n], [Symbol e])) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA ([Maybe n], [Symbol e]) e -> FSA ([Maybe n], [Symbol e]) ()
forall {n} {e}. (Ord n, Ord e) => FSA n e -> FSA n ()
rorder (FSA ([Maybe n], [Symbol e]) e -> FSA ([Maybe n], [Symbol e]) ())
-> (FSA n e -> FSA ([Maybe n], [Symbol e]) e)
-> FSA n e
-> FSA ([Maybe n], [Symbol e]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA n e -> FSA ([Maybe n], [Symbol e]) e
forall e n.
(Ord e, Ord n) =>
FSA n e -> FSA ([Maybe n], [Symbol e]) e
syntacticMonoid
>     where rorder :: FSA n e -> FSA n ()
rorder FSA n e
m = (n -> n -> Bool) -> FSA n e -> FSA n ()
forall n e.
(Ord n, Ord e) =>
(n -> n -> Bool) -> FSA n e -> FSA n ()
orderGraph (FSA n e -> n -> n -> Bool
forall {n} {e}. (Ord n, Ord e) => FSA n e -> n -> n -> Bool
r FSA n e
m) FSA n e
m
>           r :: FSA n e -> n -> n -> Bool
r FSA n e
m n
x n
y = n -> State n
forall n. n -> State n
State n
y State n -> Set (State n) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` FSA n e -> State n -> Set (State n)
forall n e. (Ord n, Ord e) => FSA n e -> State n -> Set (State n)
primitiveIdealR FSA n e
m (n -> State n
forall n. n -> State n
State n
x)

> -- |Return the number of edges in the longest path of a DAG.
> -- The precondition, that the graph be a DAG, is not checked.
> -- As a special case, return (-1) for a single-state (trivial) graph
> dagHeight :: Ord n => FSA n () -> Int
> dagHeight :: forall n. Ord n => FSA n () -> Int
dagHeight FSA n ()
f = FSA n () -> Set (State n) -> Int
forall n. Ord n => FSA n () -> Set (State n) -> Int
dagHeight' FSA n ()
f (FSA n () -> Set (State n)
forall n e. FSA n e -> Set (State n)
initials FSA n ()
f)
> dagHeight' :: Ord n => FSA n () -> Set (State n) -> Int
> dagHeight' :: forall n. Ord n => FSA n () -> Set (State n) -> Int
dagHeight' FSA n ()
f Set (State n)
xs
>     | Set (State n) -> Bool
forall a. Set a -> Bool
Set.null Set (State n)
ns = Int
0
>     | Bool
otherwise = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FSA n () -> Set (State n) -> Int
forall n. Ord n => FSA n () -> Set (State n) -> Int
dagHeight' FSA n ()
f Set (State n)
ns
>     where ts :: Set (Transition n ())
ts = FSA n () -> Set (Transition n ())
forall n e. FSA n e -> Set (Transition n e)
transitions FSA n ()
f
>           ns :: Set (State n)
ns = [Set (State n)] -> Set (State n)
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
>                ([Set (State n)] -> Set (State n))
-> ([State n] -> [Set (State n)]) -> [State n] -> Set (State n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State n -> Set (State n)) -> [State n] -> [Set (State n)]
forall a b. (a -> b) -> [a] -> [b]
map (\State n
x -> (Transition n () -> State n)
-> Set (Transition n ()) -> Set (State n)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Transition n () -> State n
forall n e. Transition n e -> State n
destination
>                      (Set (Transition n ()) -> Set (State n))
-> Set (Transition n ()) -> Set (State n)
forall a b. (a -> b) -> a -> b
$ (Transition n () -> State n)
-> State n -> Set (Transition n ()) -> Set (Transition n ())
forall a b. (Ord a, Ord b) => (a -> b) -> b -> Set a -> Set a
extractMonotonic Transition n () -> State n
forall n e. Transition n e -> State n
source State n
x Set (Transition n ())
ts)
>                ([State n] -> Set (State n)) -> [State n] -> Set (State n)
forall a b. (a -> b) -> a -> b
$ Set (State n) -> [State n]
forall a. Set a -> [a]
Set.toList Set (State n)
xs