> {-# OPTIONS_HADDOCK show-extensions #-}
> {-|
> Module:    LTK.Factors
> Copyright: (c) 2017-2019,2023 Dakotah Lambert
> License:   MIT

> This module provides a means to define
> positive and negative factors
> over the adjacency or precedence relations,
> as well as unions and intersections thereof.
> -}

> module LTK.Factors
>        ( -- *Constructions
>          required
>        , forbidden
>        , buildLiteral
>        , build
>        , makeConstraint
>        -- *Logical Expressions
>        , Factor(..)
>        , Literal(..)
>        , Disjunction(..)
>        , Conjunction(..)
>        ) where

> import Control.DeepSeq (NFData)
> import Data.Set (Set)
> import qualified Data.Set as Set

> import LTK.FSA

> -- |A substring or subsequence, from which to build constraints.
> data Factor e
>     = Substring
>       { forall e. Factor e -> [Set e]
substring :: [Set e] -- ^The sequence of symbol types,
>                              -- e.g. @[wxs0, wxs0]@
>                              -- for two consecutive unstressed syllables.
>       , forall e. Factor e -> Bool
headAnchored :: Bool -- ^Anchored to the head of the word?
>       , forall e. Factor e -> Bool
tailAnchored :: Bool -- ^Anchored to the tail of the word?
>       }
>     | Subsequence [Set e]
>     deriving (Factor e -> Factor e -> Bool
forall e. Eq e => Factor e -> Factor e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Factor e -> Factor e -> Bool
$c/= :: forall e. Eq e => Factor e -> Factor e -> Bool
== :: Factor e -> Factor e -> Bool
$c== :: forall e. Eq e => Factor e -> Factor e -> Bool
Eq, Factor e -> Factor e -> Bool
Factor e -> Factor e -> Ordering
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 (Factor e)
forall e. Ord e => Factor e -> Factor e -> Bool
forall e. Ord e => Factor e -> Factor e -> Ordering
forall e. Ord e => Factor e -> Factor e -> Factor e
min :: Factor e -> Factor e -> Factor e
$cmin :: forall e. Ord e => Factor e -> Factor e -> Factor e
max :: Factor e -> Factor e -> Factor e
$cmax :: forall e. Ord e => Factor e -> Factor e -> Factor e
>= :: Factor e -> Factor e -> Bool
$c>= :: forall e. Ord e => Factor e -> Factor e -> Bool
> :: Factor e -> Factor e -> Bool
$c> :: forall e. Ord e => Factor e -> Factor e -> Bool
<= :: Factor e -> Factor e -> Bool
$c<= :: forall e. Ord e => Factor e -> Factor e -> Bool
< :: Factor e -> Factor e -> Bool
$c< :: forall e. Ord e => Factor e -> Factor e -> Bool
compare :: Factor e -> Factor e -> Ordering
$ccompare :: forall e. Ord e => Factor e -> Factor e -> Ordering
Ord, ReadPrec [Factor e]
ReadPrec (Factor e)
ReadS [Factor e]
forall e. (Read e, Ord e) => ReadPrec [Factor e]
forall e. (Read e, Ord e) => ReadPrec (Factor e)
forall e. (Read e, Ord e) => Int -> ReadS (Factor e)
forall e. (Read e, Ord e) => ReadS [Factor e]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Factor e]
$creadListPrec :: forall e. (Read e, Ord e) => ReadPrec [Factor e]
readPrec :: ReadPrec (Factor e)
$creadPrec :: forall e. (Read e, Ord e) => ReadPrec (Factor e)
readList :: ReadS [Factor e]
$creadList :: forall e. (Read e, Ord e) => ReadS [Factor e]
readsPrec :: Int -> ReadS (Factor e)
$creadsPrec :: forall e. (Read e, Ord e) => Int -> ReadS (Factor e)
Read, Int -> Factor e -> ShowS
forall e. Show e => Int -> Factor e -> ShowS
forall e. Show e => [Factor e] -> ShowS
forall e. Show e => Factor e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Factor e] -> ShowS
$cshowList :: forall e. Show e => [Factor e] -> ShowS
show :: Factor e -> String
$cshow :: forall e. Show e => Factor e -> String
showsPrec :: Int -> Factor e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> Factor e -> ShowS
Show)

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

> -- |Multiple constraints, joined by @OR@.
> newtype Disjunction e = Disjunction (Set (Literal e))
>     deriving (Disjunction e -> Disjunction e -> Bool
forall e. Eq e => Disjunction e -> Disjunction e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Disjunction e -> Disjunction e -> Bool
$c/= :: forall e. Eq e => Disjunction e -> Disjunction e -> Bool
== :: Disjunction e -> Disjunction e -> Bool
$c== :: forall e. Eq e => Disjunction e -> Disjunction e -> Bool
Eq, Disjunction e -> Disjunction e -> Bool
Disjunction e -> Disjunction e -> Ordering
Disjunction e -> Disjunction e -> Disjunction 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 (Disjunction e)
forall e. Ord e => Disjunction e -> Disjunction e -> Bool
forall e. Ord e => Disjunction e -> Disjunction e -> Ordering
forall e. Ord e => Disjunction e -> Disjunction e -> Disjunction e
min :: Disjunction e -> Disjunction e -> Disjunction e
$cmin :: forall e. Ord e => Disjunction e -> Disjunction e -> Disjunction e
max :: Disjunction e -> Disjunction e -> Disjunction e
$cmax :: forall e. Ord e => Disjunction e -> Disjunction e -> Disjunction e
>= :: Disjunction e -> Disjunction e -> Bool
$c>= :: forall e. Ord e => Disjunction e -> Disjunction e -> Bool
> :: Disjunction e -> Disjunction e -> Bool
$c> :: forall e. Ord e => Disjunction e -> Disjunction e -> Bool
<= :: Disjunction e -> Disjunction e -> Bool
$c<= :: forall e. Ord e => Disjunction e -> Disjunction e -> Bool
< :: Disjunction e -> Disjunction e -> Bool
$c< :: forall e. Ord e => Disjunction e -> Disjunction e -> Bool
compare :: Disjunction e -> Disjunction e -> Ordering
$ccompare :: forall e. Ord e => Disjunction e -> Disjunction e -> Ordering
Ord, ReadPrec [Disjunction e]
ReadPrec (Disjunction e)
ReadS [Disjunction e]
forall e. (Read e, Ord e) => ReadPrec [Disjunction e]
forall e. (Read e, Ord e) => ReadPrec (Disjunction e)
forall e. (Read e, Ord e) => Int -> ReadS (Disjunction e)
forall e. (Read e, Ord e) => ReadS [Disjunction e]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Disjunction e]
$creadListPrec :: forall e. (Read e, Ord e) => ReadPrec [Disjunction e]
readPrec :: ReadPrec (Disjunction e)
$creadPrec :: forall e. (Read e, Ord e) => ReadPrec (Disjunction e)
readList :: ReadS [Disjunction e]
$creadList :: forall e. (Read e, Ord e) => ReadS [Disjunction e]
readsPrec :: Int -> ReadS (Disjunction e)
$creadsPrec :: forall e. (Read e, Ord e) => Int -> ReadS (Disjunction e)
Read, Int -> Disjunction e -> ShowS
forall e. Show e => Int -> Disjunction e -> ShowS
forall e. Show e => [Disjunction e] -> ShowS
forall e. Show e => Disjunction e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Disjunction e] -> ShowS
$cshowList :: forall e. Show e => [Disjunction e] -> ShowS
show :: Disjunction e -> String
$cshow :: forall e. Show e => Disjunction e -> String
showsPrec :: Int -> Disjunction e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> Disjunction e -> ShowS
Show)

> -- |Multiple disjunctions, joined by @AND@.
> newtype Conjunction e = Conjunction (Set (Disjunction e))
>     deriving (Conjunction e -> Conjunction e -> Bool
forall e. Eq e => Conjunction e -> Conjunction e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Conjunction e -> Conjunction e -> Bool
$c/= :: forall e. Eq e => Conjunction e -> Conjunction e -> Bool
== :: Conjunction e -> Conjunction e -> Bool
$c== :: forall e. Eq e => Conjunction e -> Conjunction e -> Bool
Eq, Conjunction e -> Conjunction e -> Bool
Conjunction e -> Conjunction e -> Ordering
Conjunction e -> Conjunction e -> Conjunction 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 (Conjunction e)
forall e. Ord e => Conjunction e -> Conjunction e -> Bool
forall e. Ord e => Conjunction e -> Conjunction e -> Ordering
forall e. Ord e => Conjunction e -> Conjunction e -> Conjunction e
min :: Conjunction e -> Conjunction e -> Conjunction e
$cmin :: forall e. Ord e => Conjunction e -> Conjunction e -> Conjunction e
max :: Conjunction e -> Conjunction e -> Conjunction e
$cmax :: forall e. Ord e => Conjunction e -> Conjunction e -> Conjunction e
>= :: Conjunction e -> Conjunction e -> Bool
$c>= :: forall e. Ord e => Conjunction e -> Conjunction e -> Bool
> :: Conjunction e -> Conjunction e -> Bool
$c> :: forall e. Ord e => Conjunction e -> Conjunction e -> Bool
<= :: Conjunction e -> Conjunction e -> Bool
$c<= :: forall e. Ord e => Conjunction e -> Conjunction e -> Bool
< :: Conjunction e -> Conjunction e -> Bool
$c< :: forall e. Ord e => Conjunction e -> Conjunction e -> Bool
compare :: Conjunction e -> Conjunction e -> Ordering
$ccompare :: forall e. Ord e => Conjunction e -> Conjunction e -> Ordering
Ord, ReadPrec [Conjunction e]
ReadPrec (Conjunction e)
ReadS [Conjunction e]
forall e. (Read e, Ord e) => ReadPrec [Conjunction e]
forall e. (Read e, Ord e) => ReadPrec (Conjunction e)
forall e. (Read e, Ord e) => Int -> ReadS (Conjunction e)
forall e. (Read e, Ord e) => ReadS [Conjunction e]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Conjunction e]
$creadListPrec :: forall e. (Read e, Ord e) => ReadPrec [Conjunction e]
readPrec :: ReadPrec (Conjunction e)
$creadPrec :: forall e. (Read e, Ord e) => ReadPrec (Conjunction e)
readList :: ReadS [Conjunction e]
$creadList :: forall e. (Read e, Ord e) => ReadS [Conjunction e]
readsPrec :: Int -> ReadS (Conjunction e)
$creadsPrec :: forall e. (Read e, Ord e) => Int -> ReadS (Conjunction e)
Read, Int -> Conjunction e -> ShowS
forall e. Show e => Int -> Conjunction e -> ShowS
forall e. Show e => [Conjunction e] -> ShowS
forall e. Show e => Conjunction e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Conjunction e] -> ShowS
$cshowList :: forall e. Show e => [Conjunction e] -> ShowS
show :: Conjunction e -> String
$cshow :: forall e. Show e => Conjunction e -> String
showsPrec :: Int -> Conjunction e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> Conjunction e -> ShowS
Show) -- Primitive Constraint

> -- |The factor is required to appear in every string.
> -- Note that a conjunctive constraint of
> -- (@required (Substring x True True)@)
> -- restricts the stringset to at most one word.
> required :: Factor e -> Literal e
> required :: forall e. Factor e -> Literal e
required = forall e. Bool -> Factor e -> Literal e
Literal Bool
True

> -- | The factor is not allowed to appear in any word.
> forbidden :: Factor e -> Literal e
> forbidden :: forall e. Factor e -> Literal e
forbidden = forall e. Bool -> Factor e -> Literal e
Literal Bool
False

> buildFactor :: (Enum n, Ord n, Ord e) =>
>                Set e -> Factor e -> Bool -> FSA n e
> buildFactor :: forall n e.
(Enum n, Ord n, Ord e) =>
Set e -> Factor e -> Bool -> FSA n e
buildFactor Set e
alpha (Substring [Set e]
factor Bool
anchoredToHead Bool
anchoredToTail)
>     = forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool -> Set e -> [Set e] -> FSA n e
`f` Set e
alpha) [Set e]
factor
>     where f :: Bool -> Set e -> [Set e] -> FSA n e
f = case (Bool
anchoredToHead, Bool
anchoredToTail)
>               of (Bool
True,   Bool
True)   ->  forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
word
>                  (Bool
True,   Bool
False)  ->  forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
initialLocal
>                  (Bool
False,  Bool
True)   ->  forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
finalLocal
>                  (Bool
False,  Bool
False)  ->  forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
local
> buildFactor Set e
alpha (Subsequence [Set e]
factor)
>     =  \Bool
isPositive ->
>        FSA { sigma :: Set e
sigma        =  Set e
alpha
>            , transitions :: Set (Transition n e)
transitions  =  Set (Transition n e)
tran
>            , initials :: Set (State n)
initials     =  forall c a. Container c a => a -> c
singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. n -> State n
State forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum Int
0
>            , finals :: Set (State n)
finals       =  if Bool
isPositive then Set (State n)
fin else Set (State n)
fin'
>            , isDeterministic :: Bool
isDeterministic = Bool
True
>            }
>     where tagged :: [(Set e, n)]
tagged     =  forall a b. [a] -> [b] -> [(a, b)]
zip [Set e]
factor forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate forall a. Enum a => a -> a
succ (forall a. Enum a => Int -> a
toEnum Int
0)
>           trans' :: Set (Transition n e)
trans'     =  forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll
>                         forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap
>                           (\(Set e
symset, n
st) ->
>                            forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e. Enum n => n -> e -> Transition n e
succtrans n
st)
>                                 (forall c a. (Container c a, Eq a) => c -> c -> c
intersection Set e
alpha Set e
symset)
>                            forall c a. Container c a => c -> c -> c
`union`
>                            forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e. Enum n => n -> e -> Transition n e
selftrans n
st)
>                                 (forall c a. (Container c a, Eq a) => c -> c -> c
difference Set e
alpha Set e
symset)
>                           )
>                         [(Set e, n)]
tagged
>           tran :: Set (Transition n e)
tran       =  forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e. Enum n => n -> e -> Transition n e
selftrans n
nextState) Set e
alpha
>                         forall c a. Container c a => c -> c -> c
`union` Set (Transition n e)
trans'
>           fin' :: Set (State n)
fin'       =  forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n. n -> State n
State forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Set e, n)]
tagged
>           nextState :: n
nextState  =  forall a. Enum a => a -> a
succ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap forall a b. (a, b) -> b
snd [(Set e, n)]
tagged
>           fin :: Set (State n)
fin        =  forall c a. Container c a => a -> c
singleton (forall n. n -> State n
State n
nextState)

> -- |Build an 'FSA' representing a single constraint.
> buildLiteral :: (Enum n, Ord n, Ord e) => Set e -> Literal e -> FSA n e
> buildLiteral :: forall n e. (Enum n, Ord n, Ord e) => Set e -> Literal e -> FSA n e
buildLiteral Set e
alpha (Literal Bool
isPositive Factor e
factor)
>     = forall n e.
(Enum n, Ord n, Ord e) =>
Set e -> Factor e -> Bool -> FSA n e
buildFactor Set e
alpha Factor e
factor Bool
isPositive

> buildDisjunction :: (Enum n, NFData n, Ord n, NFData e, Ord e) =>
>                     Set e -> Disjunction e -> FSA n e
> buildDisjunction :: forall n e.
(Enum n, NFData n, Ord n, NFData e, Ord e) =>
Set e -> Disjunction e -> FSA n e
buildDisjunction Set e
alpha (Disjunction Set (Literal e)
literals)
>     = forall n e.
(Enum n, Ord n, NFData n, Ord e, NFData e) =>
[FSA n e] -> FSA n e
flatUnion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a. Container c a => a -> c -> c
insert (forall e n. (Ord e, Enum n, Ord n) => Set e -> FSA n e
emptyWithAlphabet Set e
alpha) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>       forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e. (Enum n, Ord n, Ord e) => Set e -> Literal e -> FSA n e
buildLiteral Set e
alpha) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set (Literal e)
literals

> buildConjunction :: (Enum n, NFData n, Ord n, NFData e, Ord e) =>
>                     Set e -> Conjunction e -> FSA n e
> buildConjunction :: forall n e.
(Enum n, NFData n, Ord n, NFData e, Ord e) =>
Set e -> Conjunction e -> FSA n e
buildConjunction Set e
alpha (Conjunction Set (Disjunction e)
disjunctions)
>     = forall n e.
(Enum n, Ord n, NFData n, Ord e, NFData e) =>
[FSA n e] -> FSA n e
flatIntersection forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a. Container c a => a -> c -> c
insert (forall e n. (Ord e, Enum n, Ord n) => Set e -> FSA n e
totalWithAlphabet Set e
alpha) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>       forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e.
(Enum n, NFData n, Ord n, NFData e, Ord e) =>
Set e -> Disjunction e -> FSA n e
buildDisjunction Set e
alpha) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set (Disjunction e)
disjunctions

> -- |Build an 'FSA' representing the conjunction of a set of
> -- constraints provided in conjunctive normal form.
> build :: (Enum n, NFData n, Ord n, NFData e, Ord e) =>
>          Set e -> Set (Conjunction e) -> FSA n e
> build :: forall n e.
(Enum n, NFData n, Ord n, NFData e, Ord e) =>
Set e -> Set (Conjunction e) -> FSA n e
build Set e
alpha = forall n e.
(Enum n, Ord n, NFData n, Ord e, NFData e) =>
[FSA n e] -> FSA n e
flatIntersection                  forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>               forall c a. Container c a => a -> c -> c
insert (forall e n. (Ord e, Enum n, Ord n) => Set e -> FSA n e
totalWithAlphabet Set e
alpha)  forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>               forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e.
(Enum n, NFData n, Ord n, NFData e, Ord e) =>
Set e -> Conjunction e -> FSA n e
buildConjunction Set e
alpha) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList

> -- |Combine inner lists by 'Disjunction',
> -- and form a 'Conjunction' of the results.
> makeConstraint :: (Ord e) => [[Literal e]] -> Conjunction e
> makeConstraint :: forall e. Ord e => [[Literal e]] -> Conjunction e
makeConstraint
>     = forall e. Set (Disjunction e) -> Conjunction e
Conjunction forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall e. Set (Literal e) -> Disjunction e
Disjunction forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList)

> word :: (Enum a, Ord a, Ord b) =>
>              Bool -> Set b -> [Set b] -> FSA a b
> word :: forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
word Bool
True  Set b
alpha []  =  forall e n. (Ord e, Enum n, Ord n) => Set e -> [e] -> FSA n e
singletonWithAlphabet Set b
alpha []
> word Bool
False Set b
alpha []  =  forall e n. (Ord e, Ord n) => FSA n e -> FSA n e
complementDeterministic forall a b. (a -> b) -> a -> b
$
>                         forall e n. (Ord e, Enum n, Ord n) => Set e -> [e] -> FSA n e
singletonWithAlphabet Set b
alpha []
> word Bool
isPositive Set b
alpha [Set b]
symseq
>     = forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>       (if Bool
isPositive then forall a. a -> a
id else forall e n. (Ord e, Ord n) => FSA n e -> FSA n e
complementDeterministic) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>       forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set n) e
determinize forall a b. (a -> b) -> a -> b
$
>       FSA { sigma :: Set b
sigma            =  Set b
alpha
>           , transitions :: Set (Transition Integer b)
transitions      =  Set (Transition Integer b)
trans
>           , initials :: Set (State Integer)
initials         =  forall c a. Container c a => a -> c
singleton forall a b. (a -> b) -> a -> b
$ forall n. n -> State n
State Integer
0
>           , finals :: Set (State Integer)
finals           =  forall c a. Container c a => a -> c
singleton forall a b. (a -> b) -> a -> b
$ forall n. n -> State n
State Integer
nextState
>           , isDeterministic :: Bool
isDeterministic  =  Bool
False
>           }
>     where tagged :: [(Set b, Integer)]
tagged     =  forall a b. [a] -> [b] -> [(a, b)]
zip [Set b]
symseq [Integer
0 :: Integer ..]
>           trans' :: Set (Transition Integer b)
trans'     =  forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll forall a b. (a -> b) -> a -> b
$
>                         forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap
>                         (\(Set b
symset, Integer
st) ->
>                          forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e. Enum n => n -> e -> Transition n e
succtrans Integer
st)
>                               (forall c a. (Container c a, Eq a) => c -> c -> c
intersection Set b
alpha Set b
symset)
>                          forall c a. Container c a => c -> c -> c
`union`
>                          forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e. n -> n -> e -> Transition n e
sinktrans Integer
sinkState Integer
st)
>                               (forall c a. (Container c a, Eq a) => c -> c -> c
difference Set b
alpha Set b
symset)
>                         )
>                         [(Set b, Integer)]
tagged
>           trans :: Set (Transition Integer b)
trans      =  forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e. Enum n => n -> e -> Transition n e
succtrans Integer
nextState) Set b
alpha
>                         forall c a. Container c a => c -> c -> c
`union` Set (Transition Integer b)
trans'
>           nextState :: Integer
nextState  =  forall a. Enum a => a -> a
succ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap forall a b. (a, b) -> b
snd [(Set b, Integer)]
tagged
>           sinkState :: Integer
sinkState  =  forall a. Enum a => a -> a
succ Integer
nextState

> initialLocal :: (Enum a, Ord a, Ord b) =>
>                 Bool -> Set b -> [Set b] -> FSA a b
> initialLocal :: forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
initialLocal Bool
True  Set b
a [] = forall e n. (Ord e, Ord n) => FSA n e -> FSA n e
complementDeterministic forall a b. (a -> b) -> a -> b
$ forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
initialLocal Bool
False Set b
a []
> initialLocal Bool
False Set b
a [] = forall e n. (Ord e, Enum n, Ord n) => Set e -> FSA n e
emptyWithAlphabet Set b
a
> initialLocal Bool
isPositive Set b
alpha [Set b]
symseq
>     = FSA { sigma :: Set b
sigma            =  Set b
alpha
>           , transitions :: Set (Transition a b)
transitions      =  Set (Transition a b)
trans
>           , initials :: Set (State a)
initials         =  forall c a. Container c a => a -> c
singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. n -> State n
State forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum Int
0
>           , finals :: Set (State a)
finals           =  if Bool
isPositive then Set (State a)
fin else Set (State a)
fin'
>           , isDeterministic :: Bool
isDeterministic  =  Bool
True
>           }
>     where tagged :: [(Set b, a)]
tagged     =  forall a b. [a] -> [b] -> [(a, b)]
zip [Set b]
symseq forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate forall a. Enum a => a -> a
succ (forall a. Enum a => Int -> a
toEnum Int
0)
>           trans' :: Set (Transition a b)
trans'     =  forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll forall a b. (a -> b) -> a -> b
$
>                         forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap
>                         (\(Set b
symset, a
st) ->
>                          forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e. Enum n => n -> e -> Transition n e
succtrans a
st)
>                               (forall c a. (Container c a, Eq a) => c -> c -> c
intersection Set b
alpha Set b
symset)
>                          forall c a. Container c a => c -> c -> c
`union`
>                          forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e. n -> n -> e -> Transition n e
sinktrans a
sinkState a
st)
>                               (forall c a. (Container c a, Eq a) => c -> c -> c
difference Set b
alpha Set b
symset)
>                         ) [(Set b, a)]
tagged
>           trans :: Set (Transition a b)
trans      =  forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll
>                         [ forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e. Enum n => n -> e -> Transition n e
selftrans a
nextState) Set b
alpha
>                         , forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e. Enum n => n -> e -> Transition n e
selftrans a
sinkState) Set b
alpha
>                         , Set (Transition a b)
trans'
>                         ]
>           nextState :: a
nextState  =  forall a. Enum a => a -> a
succ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap forall a b. (a, b) -> b
snd [(Set b, a)]
tagged
>           sinkState :: a
sinkState  =  forall a. Enum a => a -> a
succ a
nextState
>           fin' :: Set (State a)
fin'       =  forall c a. Container c a => a -> c -> c
insert
>                         (forall n. n -> State n
State a
sinkState)
>                         (forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n. n -> State n
State forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Set b, a)]
tagged)
>           fin :: Set (State a)
fin        =  forall c a. Container c a => a -> c
singleton (forall n. n -> State n
State a
nextState)

For final and non-anchored factors, it would be nice to use KMP.
However, for that to work properly, I believe we would have to expand
the symbol-sets, then combine all the results with either union or
intersection (depending on whether the factor is to be positive or
negative).  Making these from NFAs is cheaper, it seems.

> finalLocal :: (Enum a, Ord a, Ord b) =>
>                 Bool -> Set b -> [Set b] -> FSA a b
> finalLocal :: forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
finalLocal Bool
True  Set b
a [] = forall e n. (Ord e, Ord n) => FSA n e -> FSA n e
complementDeterministic forall a b. (a -> b) -> a -> b
$ forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
finalLocal Bool
False Set b
a []
> finalLocal Bool
False Set b
a [] = forall e n. (Ord e, Enum n, Ord n) => Set e -> FSA n e
emptyWithAlphabet Set b
a
> finalLocal Bool
isPositive Set b
alpha [Set b]
symseq
>     = forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
isPositive then forall a. a -> a
id else forall e n. (Ord e, Ord n) => FSA n e -> FSA n e
complementDeterministic) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>       forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set n) e
determinize forall a b. (a -> b) -> a -> b
$ FSA { sigma :: Set b
sigma            =  Set b
alpha
>                         , transitions :: Set (Transition Integer b)
transitions      =  Set (Transition Integer b)
trans
>                         , initials :: Set (State Integer)
initials         =  forall c a. Container c a => a -> c
singleton forall a b. (a -> b) -> a -> b
$ forall n. n -> State n
State Integer
0
>                         , finals :: Set (State Integer)
finals           =  forall c a. Container c a => a -> c
singleton forall a b. (a -> b) -> a -> b
$ forall n. n -> State n
State Integer
nextState
>                         , isDeterministic :: Bool
isDeterministic  =  Bool
False
>                         }
>     where tagged :: [(Set b, Integer)]
tagged     =  forall a b. [a] -> [b] -> [(a, b)]
zip [Set b]
symseq [Integer
0 :: Integer ..]
>           trans' :: Set (Transition Integer b)
trans'     =  forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll
>                         forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap
>                           (\(Set b
symset, Integer
st) ->
>                            forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e. Enum n => n -> e -> Transition n e
succtrans Integer
st)
>                            forall a b. (a -> b) -> a -> b
$ forall c a. (Container c a, Eq a) => c -> c -> c
intersection Set b
alpha Set b
symset
>                           ) [(Set b, Integer)]
tagged
>           trans :: Set (Transition Integer b)
trans      =  forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e. Enum n => n -> e -> Transition n e
selftrans Integer
0) Set b
alpha forall c a. Container c a => c -> c -> c
`union` Set (Transition Integer b)
trans'
>           nextState :: Integer
nextState  =  forall a. Enum a => a -> a
succ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap forall a b. (a, b) -> b
snd [(Set b, Integer)]
tagged

> local :: (Enum a, Ord a, Ord b) =>
>                 Bool -> Set b -> [Set b] -> FSA a b
> local :: forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
local Bool
True  Set b
alpha [] = forall e n. (Ord e, Ord n) => FSA n e -> FSA n e
complementDeterministic forall a b. (a -> b) -> a -> b
$ forall a b.
(Enum a, Ord a, Ord b) =>
Bool -> Set b -> [Set b] -> FSA a b
local Bool
False Set b
alpha []
> local Bool
False Set b
alpha [] = forall e n. (Ord e, Enum n, Ord n) => Set e -> FSA n e
emptyWithAlphabet Set b
alpha
> local Bool
isPositive Set b
alpha [Set b]
symseq
>     = forall e n n1.
(Ord e, Ord n, Ord n1, Enum n1) =>
FSA n e -> FSA n1 e
renameStates forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>       (if Bool
isPositive then forall a. a -> a
id else forall e n. (Ord e, Ord n) => FSA n e -> FSA n e
complementDeterministic) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>       forall e n. (Ord e, Ord n) => FSA n e -> FSA (Set n) e
determinize forall a b. (a -> b) -> a -> b
$
>       FSA
>       { sigma :: Set b
sigma        =  Set b
alpha
>       , transitions :: Set (Transition Integer b)
transitions  =  Set (Transition Integer b)
trans
>       , initials :: Set (State Integer)
initials     =  forall c a. Container c a => a -> c
singleton forall a b. (a -> b) -> a -> b
$ forall n. n -> State n
State Integer
0
>       , finals :: Set (State Integer)
finals       =  forall c a. Container c a => a -> c
singleton forall a b. (a -> b) -> a -> b
$ forall n. n -> State n
State Integer
nextState
>       , isDeterministic :: Bool
isDeterministic = Bool
False
>       }
>     where tagged :: [(Set b, Integer)]
tagged  = forall a b. [a] -> [b] -> [(a, b)]
zip [Set b]
symseq [Integer
0 :: Integer ..]
>           trans' :: Set (Transition Integer b)
trans'  = forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll forall a b. (a -> b) -> a -> b
$
>                     forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap
>                     (\(Set b
symset, Integer
st) ->
>                      forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e. Enum n => n -> e -> Transition n e
succtrans Integer
st) forall a b. (a -> b) -> a -> b
$ forall c a. (Container c a, Eq a) => c -> c -> c
intersection Set b
alpha Set b
symset
>                     )
>                     [(Set b, Integer)]
tagged
>           trans :: Set (Transition Integer b)
trans   = forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll
>                     [forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e. Enum n => n -> e -> Transition n e
selftrans Integer
0) Set b
alpha
>                     , forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap (forall n e. Enum n => n -> e -> Transition n e
selftrans Integer
nextState) Set b
alpha
>                     , Set (Transition Integer b)
trans'
>                     ]
>           nextState :: Integer
nextState = forall a. Enum a => a -> a
succ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap forall a b. (a, b) -> b
snd [(Set b, Integer)]
tagged

> selftrans, succtrans :: (Enum n) => n -> e -> Transition n e
> selftrans :: forall n e. Enum n => n -> e -> Transition n e
selftrans  =  forall n e. (n -> n) -> n -> e -> Transition n e
transTo forall a. a -> a
id
> succtrans :: forall n e. Enum n => n -> e -> Transition n e
succtrans  =  forall n e. (n -> n) -> n -> e -> Transition n e
transTo forall a. Enum a => a -> a
succ

> sinktrans :: n -> n -> e -> Transition n e
> sinktrans :: forall n e. n -> n -> e -> Transition n e
sinktrans n
sinkState = forall n e. (n -> n) -> n -> e -> Transition n e
transTo (forall a b. a -> b -> a
const n
sinkState)

> transTo :: (n -> n) -> n -> e -> Transition n e
> transTo :: forall n e. (n -> n) -> n -> e -> Transition n e
transTo n -> n
f n
n e
x
>     = Transition
>       { edgeLabel :: Symbol e
edgeLabel = forall e. e -> Symbol e
Symbol e
x
>       , source :: State n
source = forall n. n -> State n
State n
n
>       , destination :: State n
destination = forall n. n -> State n
State forall a b. (a -> b) -> a -> b
$ n -> n
f n
n
>       }