> {-# OPTIONS_HADDOCK show-extensions #-}
> {-|
> Module    : LTK.Learn.TSL.AugmentedSubsequences
> Copyright : (c) 2019-2020 Dakotah Lambert
> License   : MIT

> This module implements a string extension learner for the TSL class.
> A variant of the tier-finding algorithm of Jardine and McMullin (2017)
> is used along with a notion of a potential valid tier-factor.
> This is an efficient online conversion of their algorithm.
> 
> For the original work, see https://doi.org/10.1007/978-3-319-53733-7_4
>
> @since 0.3
> -}

> module LTK.Learn.TSL.AugmentedSubsequences(TSLG, fTSL) where

> import Data.Set (Set)
> import qualified Data.Set as Set

> import LTK.FSA
> import LTK.Learn.StringExt
> import LTK.Learn.SL

> -- |Return the set of subsequence-interveners pairs
> -- of length \(k\) in a given word,
> -- as well as the adjacency factors of length \(k\) and \(k+1\).
> -- If a word is short enough to not contain any \(k\)-factors,
> -- the entire word, appropriately anchored, is included in the set.
> fTSL :: Ord a => Int -> [a] -> TSLG a
> fTSL :: Int -> [a] -> TSLG a
fTSL Int
k [a]
w = TSLG :: forall a.
Set a
-> Bool
-> Int
-> SLG a
-> SLG a
-> Set (Set a, (Bool, [a], Bool), Set a)
-> TSLG a
TSLG { tslgAlpha :: Set a
tslgAlpha  =  Set a
as
>                 , tslgInf :: Bool
tslgInf    =  Bool
inf
>                 , tslgK :: Int
tslgK      =  Int
k
>                 , tslgF :: SLG a
tslgF      =  Int -> [a] -> SLG a
forall a. Ord a => Int -> [a] -> SLG a
fSL Int
k [a]
w
>                 , tslgFp1 :: SLG a
tslgFp1    =  Int -> [a] -> SLG a
forall a. Ord a => Int -> [a] -> SLG a
fSL (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
w
>                 , tslg :: Set (Set a, (Bool, [a], Bool), Set a)
tslg       =  Set (Set a, (Bool, [a], Bool), Set a)
fs
>                 }
>     where fs :: Set (Set a, (Bool, [a], Bool), Set a)
fs   =  ((Set a, (Bool, [a], Bool), Set a) -> Bool)
-> Set (Set a, (Bool, [a], Bool), Set a)
-> Set (Set a, (Bool, [a], Bool), Set a)
forall (s :: * -> *) a.
(Collapsible s, Container (s a) a) =>
(a -> Bool) -> s a -> s a
keep (\(Set a
_,(Bool, [a], Bool)
b,Set a
_) -> (Bool, [a], Bool) -> Bool
forall a. (Bool, [a], Bool) -> Bool
f (Bool, [a], Bool)
b) (Set (Set a, (Bool, [a], Bool), Set a)
 -> Set (Set a, (Bool, [a], Bool), Set a))
-> Set (Set a, (Bool, [a], Bool), Set a)
-> Set (Set a, (Bool, [a], Bool), Set a)
forall a b. (a -> b) -> a -> b
$ [a] -> Set (Set a, (Bool, [a], Bool), Set a)
forall a. Ord a => [a] -> Set (Set a, (Bool, [a], Bool), Set a)
ssqis [a]
w
>           f :: (Bool, [a], Bool) -> Bool
f (Bool
h, [a]
b, Bool
t)
>               = let a :: Int
a = (Bool, [a], Bool) -> Int
forall a. (Bool, [a], Bool) -> Int
alength (Bool
h, [a]
b, Bool
t)
>                 in (Bool
h Bool -> Bool -> Bool
&& Bool
t Bool -> Bool -> Bool
&& Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
k) Bool -> Bool -> Bool
|| Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k
>           as :: Set a
as   =  ((Set a, (Bool, [a], Bool), Set a) -> Set a -> Set a)
-> Set a -> Set (Set a, (Bool, [a], Bool), Set a) -> Set a
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (Set a -> Set a -> Set a
forall c a. Container c a => c -> c -> c
union (Set a -> Set a -> Set a)
-> ((Set a, (Bool, [a], Bool), Set a) -> Set a)
-> (Set a, (Bool, [a], Bool), Set a)
-> Set a
-> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Set a
a,(Bool, [a], Bool)
_,Set a
_) -> Set a
a)) Set a
forall c a. Container c a => c
empty Set (Set a, (Bool, [a], Bool), Set a)
fs
>           inf :: Bool
inf  =  ((Set a, (Bool, [a], Bool), Set a) -> Bool)
-> Set (Set a, (Bool, [a], Bool), Set a) -> Bool
forall (s :: * -> *) a. Collapsible s => (a -> Bool) -> s a -> Bool
anyS (\(Set a
_,(Bool
h,[a]
_,Bool
t),Set a
_) -> Bool -> Bool
not Bool
h Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
t) Set (Set a, (Bool, [a], Bool), Set a)
fs

> tslgTier :: Ord a => TSLG a -> Set a
> tslgTier :: TSLG a -> Set a
tslgTier TSLG a
g = (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
n) (TSLG a -> Set a
forall (g :: * -> *) e. HasAlphabet g => g e -> Set e
alphabet TSLG a
g)
>     where n :: a -> Bool
n   = (a -> Bool) -> (a -> Bool) -> a -> Bool
forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
both a -> Bool
r a -> Bool
p
>           r :: a -> Bool
r a
x = Set (Bool, [a], Bool) -> Set (Bool, [a], Bool) -> Bool
forall c a. (Container c a, Eq a) => c -> c -> Bool
isSubsetOf (SLG a -> Set (Bool, [a], Bool)
forall a. SLG a -> Set (Bool, [a], Bool)
slg (SLG a -> Set (Bool, [a], Bool)) -> SLG a -> Set (Bool, [a], Bool)
forall a b. (a -> b) -> a -> b
$ TSLG a -> SLG a
forall a. TSLG a -> SLG a
tslgF TSLG a
g) (Set (Bool, [a], Bool) -> Bool) -> Set (Bool, [a], Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Set (Bool, [a], Bool) -> Set (Bool, [a], Bool)
forall a.
Ord a =>
a -> Set (Bool, [a], Bool) -> Set (Bool, [a], Bool)
gDrop a
x (SLG a -> Set (Bool, [a], Bool)
forall a. SLG a -> Set (Bool, [a], Bool)
slg (SLG a -> Set (Bool, [a], Bool)) -> SLG a -> Set (Bool, [a], Bool)
forall a b. (a -> b) -> a -> b
$ TSLG a -> SLG a
forall a. TSLG a -> SLG a
tslgFp1 TSLG a
g)
>           p :: a -> Bool
p a
x = Set (Bool, [a], Bool) -> Set (Bool, [a], Bool) -> Bool
forall c a. (Container c a, Eq a) => c -> c -> Bool
isSubsetOf (SLG a -> Set (Bool, [a], Bool)
forall a. SLG a -> Set (Bool, [a], Bool)
slg (SLG a -> Set (Bool, [a], Bool)) -> SLG a -> Set (Bool, [a], Bool)
forall a b. (a -> b) -> a -> b
$ TSLG a -> SLG a
forall a. TSLG a -> SLG a
tslgFp1 TSLG a
g) (Set (Bool, [a], Bool) -> Bool) -> Set (Bool, [a], Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Set (Bool, [a], Bool) -> Set (Bool, [a], Bool)
forall a.
Ord a =>
a -> Set (Bool, [a], Bool) -> Set (Bool, [a], Bool)
gIn a
x (SLG a -> Set (Bool, [a], Bool)
forall a. SLG a -> Set (Bool, [a], Bool)
slg (SLG a -> Set (Bool, [a], Bool)) -> SLG a -> Set (Bool, [a], Bool)
forall a b. (a -> b) -> a -> b
$ TSLG a -> SLG a
forall a. TSLG a -> SLG a
tslgF TSLG a
g)

> slgFromTslg :: Ord a => TSLG a -> SLG a
> slgFromTslg :: TSLG a -> SLG a
slgFromTslg TSLG a
g = SLG :: forall a. Set a -> Int -> Set (Bool, [a], Bool) -> SLG a
SLG { slgAlpha :: Set a
slgAlpha = Set a
t
>                     , slgK :: Int
slgK = TSLG a -> Int
forall a. TSLG a -> Int
tslgK TSLG a
g
>                     , slg :: Set (Bool, [a], Bool)
slg = ((Set a, (Bool, [a], Bool), Set a) -> (Bool, [a], Bool))
-> Set (Set a, (Bool, [a], Bool), Set a) -> Set (Bool, [a], Bool)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Set a, (Bool, [a], Bool), Set a) -> (Bool, [a], Bool)
forall a b c. (a, b, c) -> b
ex (Set (Set a, (Bool, [a], Bool), Set a) -> Set (Bool, [a], Bool))
-> (Set (Set a, (Bool, [a], Bool), Set a)
    -> Set (Set a, (Bool, [a], Bool), Set a))
-> Set (Set a, (Bool, [a], Bool), Set a)
-> Set (Bool, [a], Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Set a, (Bool, [a], Bool), Set a) -> Bool)
-> Set (Set a, (Bool, [a], Bool), Set a)
-> Set (Set a, (Bool, [a], Bool), Set a)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Set a, (Bool, [a], Bool), Set a) -> Bool
forall b. (Set a, b, Set a) -> Bool
f (Set (Set a, (Bool, [a], Bool), Set a) -> Set (Bool, [a], Bool))
-> Set (Set a, (Bool, [a], Bool), Set a) -> Set (Bool, [a], Bool)
forall a b. (a -> b) -> a -> b
$ TSLG a -> Set (Set a, (Bool, [a], Bool), Set a)
forall a. TSLG a -> Set (Set a, (Bool, [a], Bool), Set a)
tslg TSLG a
g
>                     }
>     where t :: Set a
t = TSLG a -> Set a
forall a. Ord a => TSLG a -> Set a
tslgTier TSLG a
g
>           f :: (Set a, b, Set a) -> Bool
f (Set a
x, b
_, Set a
y) = Set a -> Set a -> Bool
forall c a. (Container c a, Eq a) => c -> c -> Bool
isSubsetOf Set a
t Set a
x Bool -> Bool -> Bool
&&
>                         Set a -> Bool
forall a. Set a -> Bool
Set.null (Set a -> Set a -> Set a
forall c a. (Container c a, Eq a) => c -> c -> c
intersection Set a
y Set a
t)
>           ex :: (a, b, c) -> b
ex (a
_, b
s, c
_) = b
s



> -- |A representation of a TSL grammar.
> data TSLG a = TSLG { TSLG a -> Set a
tslgAlpha :: Set a
>                    , TSLG a -> Bool
tslgInf :: Bool
>                    , TSLG a -> Int
tslgK :: Int
>                    , TSLG a -> SLG a
tslgF :: SLG a
>                    , TSLG a -> SLG a
tslgFp1 :: SLG a
>                    , TSLG a -> Set (Set a, (Bool, [a], Bool), Set a)
tslg :: Set (Set a, (Bool, [a], Bool), Set a)
>                    }
>               deriving (TSLG a -> TSLG a -> Bool
(TSLG a -> TSLG a -> Bool)
-> (TSLG a -> TSLG a -> Bool) -> Eq (TSLG a)
forall a. Eq a => TSLG a -> TSLG a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TSLG a -> TSLG a -> Bool
$c/= :: forall a. Eq a => TSLG a -> TSLG a -> Bool
== :: TSLG a -> TSLG a -> Bool
$c== :: forall a. Eq a => TSLG a -> TSLG a -> Bool
Eq, Eq (TSLG a)
Eq (TSLG a)
-> (TSLG a -> TSLG a -> Ordering)
-> (TSLG a -> TSLG a -> Bool)
-> (TSLG a -> TSLG a -> Bool)
-> (TSLG a -> TSLG a -> Bool)
-> (TSLG a -> TSLG a -> Bool)
-> (TSLG a -> TSLG a -> TSLG a)
-> (TSLG a -> TSLG a -> TSLG a)
-> Ord (TSLG a)
TSLG a -> TSLG a -> Bool
TSLG a -> TSLG a -> Ordering
TSLG a -> TSLG a -> TSLG a
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 a. Ord a => Eq (TSLG a)
forall a. Ord a => TSLG a -> TSLG a -> Bool
forall a. Ord a => TSLG a -> TSLG a -> Ordering
forall a. Ord a => TSLG a -> TSLG a -> TSLG a
min :: TSLG a -> TSLG a -> TSLG a
$cmin :: forall a. Ord a => TSLG a -> TSLG a -> TSLG a
max :: TSLG a -> TSLG a -> TSLG a
$cmax :: forall a. Ord a => TSLG a -> TSLG a -> TSLG a
>= :: TSLG a -> TSLG a -> Bool
$c>= :: forall a. Ord a => TSLG a -> TSLG a -> Bool
> :: TSLG a -> TSLG a -> Bool
$c> :: forall a. Ord a => TSLG a -> TSLG a -> Bool
<= :: TSLG a -> TSLG a -> Bool
$c<= :: forall a. Ord a => TSLG a -> TSLG a -> Bool
< :: TSLG a -> TSLG a -> Bool
$c< :: forall a. Ord a => TSLG a -> TSLG a -> Bool
compare :: TSLG a -> TSLG a -> Ordering
$ccompare :: forall a. Ord a => TSLG a -> TSLG a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (TSLG a)
Ord, ReadPrec [TSLG a]
ReadPrec (TSLG a)
Int -> ReadS (TSLG a)
ReadS [TSLG a]
(Int -> ReadS (TSLG a))
-> ReadS [TSLG a]
-> ReadPrec (TSLG a)
-> ReadPrec [TSLG a]
-> Read (TSLG a)
forall a. (Read a, Ord a) => ReadPrec [TSLG a]
forall a. (Read a, Ord a) => ReadPrec (TSLG a)
forall a. (Read a, Ord a) => Int -> ReadS (TSLG a)
forall a. (Read a, Ord a) => ReadS [TSLG a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TSLG a]
$creadListPrec :: forall a. (Read a, Ord a) => ReadPrec [TSLG a]
readPrec :: ReadPrec (TSLG a)
$creadPrec :: forall a. (Read a, Ord a) => ReadPrec (TSLG a)
readList :: ReadS [TSLG a]
$creadList :: forall a. (Read a, Ord a) => ReadS [TSLG a]
readsPrec :: Int -> ReadS (TSLG a)
$creadsPrec :: forall a. (Read a, Ord a) => Int -> ReadS (TSLG a)
Read, Int -> TSLG a -> ShowS
[TSLG a] -> ShowS
TSLG a -> String
(Int -> TSLG a -> ShowS)
-> (TSLG a -> String) -> ([TSLG a] -> ShowS) -> Show (TSLG a)
forall a. Show a => Int -> TSLG a -> ShowS
forall a. Show a => [TSLG a] -> ShowS
forall a. Show a => TSLG a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TSLG a] -> ShowS
$cshowList :: forall a. Show a => [TSLG a] -> ShowS
show :: TSLG a -> String
$cshow :: forall a. Show a => TSLG a -> String
showsPrec :: Int -> TSLG a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> TSLG a -> ShowS
Show)

> instance HasAlphabet TSLG
>     where alphabet :: TSLG e -> Set e
alphabet = TSLG e -> Set e
forall e. TSLG e -> Set e
tslgAlpha

> instance Grammar TSLG
>     where emptyG :: TSLG a
emptyG = Set a
-> Bool
-> Int
-> SLG a
-> SLG a
-> Set (Set a, (Bool, [a], Bool), Set a)
-> TSLG a
forall a.
Set a
-> Bool
-> Int
-> SLG a
-> SLG a
-> Set (Set a, (Bool, [a], Bool), Set a)
-> TSLG a
TSLG Set a
forall c a. Container c a => c
empty Bool
False Int
0 SLG a
forall (g :: * -> *) a. (Grammar g, Ord a) => g a
emptyG SLG a
forall (g :: * -> *) a. (Grammar g, Ord a) => g a
emptyG Set (Set a, (Bool, [a], Bool), Set a)
forall c a. Container c a => c
empty
>           augmentG :: TSLG a -> TSLG a -> TSLG a
augmentG TSLG a
g1 TSLG a
g2
>               = TSLG :: forall a.
Set a
-> Bool
-> Int
-> SLG a
-> SLG a
-> Set (Set a, (Bool, [a], Bool), Set a)
-> TSLG a
TSLG { tslgAlpha :: Set a
tslgAlpha  =  Set a -> Set a -> Set a
forall c a. Container c a => c -> c -> c
union (TSLG a -> Set a
forall (g :: * -> *) e. HasAlphabet g => g e -> Set e
alphabet TSLG a
g1) (TSLG a -> Set a
forall (g :: * -> *) e. HasAlphabet g => g e -> Set e
alphabet TSLG a
g2)
>                      , tslgInf :: Bool
tslgInf    =  TSLG a -> Bool
forall a. TSLG a -> Bool
tslgInf TSLG a
g1 Bool -> Bool -> Bool
|| TSLG a -> Bool
forall a. TSLG a -> Bool
tslgInf TSLG a
g2
>                      , tslgK :: Int
tslgK      =  Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (TSLG a -> Int
forall a. TSLG a -> Int
tslgK TSLG a
g1) (TSLG a -> Int
forall a. TSLG a -> Int
tslgK TSLG a
g2)
>                      , tslgF :: SLG a
tslgF      =  SLG a -> SLG a -> SLG a
forall (g :: * -> *) a. (Grammar g, Ord a) => g a -> g a -> g a
augmentG (TSLG a -> SLG a
forall a. TSLG a -> SLG a
tslgF TSLG a
g1) (TSLG a -> SLG a
forall a. TSLG a -> SLG a
tslgF TSLG a
g2)
>                      , tslgFp1 :: SLG a
tslgFp1    =  SLG a -> SLG a -> SLG a
forall (g :: * -> *) a. (Grammar g, Ord a) => g a -> g a -> g a
augmentG (TSLG a -> SLG a
forall a. TSLG a -> SLG a
tslgFp1 TSLG a
g1) (TSLG a -> SLG a
forall a. TSLG a -> SLG a
tslgFp1 TSLG a
g2)
>                      , tslg :: Set (Set a, (Bool, [a], Bool), Set a)
tslg       =  Set (Set a, (Bool, [a], Bool), Set a)
-> Set (Set a, (Bool, [a], Bool), Set a)
-> Set (Set a, (Bool, [a], Bool), Set a)
forall c a. Container c a => c -> c -> c
union (TSLG a -> Set (Set a, (Bool, [a], Bool), Set a)
forall a. TSLG a -> Set (Set a, (Bool, [a], Bool), Set a)
tslg TSLG a
g1) (TSLG a -> Set (Set a, (Bool, [a], Bool), Set a)
forall a. TSLG a -> Set (Set a, (Bool, [a], Bool), Set a)
tslg TSLG a
g2)
>                      }
>           isSubGOf :: TSLG a -> TSLG a -> Bool
isSubGOf TSLG a
g1 TSLG a
g2 = Set (Set a, (Bool, [a], Bool), Set a)
-> Set (Set a, (Bool, [a], Bool), Set a) -> Bool
forall c a. (Container c a, Eq a) => c -> c -> Bool
isSubsetOf (TSLG a -> Set (Set a, (Bool, [a], Bool), Set a)
forall a. TSLG a -> Set (Set a, (Bool, [a], Bool), Set a)
tslg TSLG a
g1) (TSLG a -> Set (Set a, (Bool, [a], Bool), Set a)
forall a. TSLG a -> Set (Set a, (Bool, [a], Bool), Set a)
tslg TSLG a
g2)
>           genFSA :: TSLG a -> FSA Integer a
genFSA TSLG a
g = FSA (Maybe Integer, Maybe Integer) a -> FSA Integer a
forall e n. (Ord e, Ord n) => FSA n e -> FSA Integer e
normalize (FSA (Maybe Integer, Maybe Integer) a -> FSA Integer a)
-> (SLG a -> FSA (Maybe Integer, Maybe Integer) a)
-> SLG a
-> FSA Integer a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSA (Maybe Integer, Maybe Integer) (Maybe a)
-> FSA (Maybe Integer, Maybe Integer) a
forall a b. (Ord a, Ord b) => FSA a (Maybe b) -> FSA a b
desemantify (FSA (Maybe Integer, Maybe Integer) (Maybe a)
 -> FSA (Maybe Integer, Maybe Integer) a)
-> (SLG a -> FSA (Maybe Integer, Maybe Integer) (Maybe a))
-> SLG a
-> FSA (Maybe Integer, Maybe Integer) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                      Set a
-> FSA (Maybe Integer, Maybe Integer) (Maybe a)
-> FSA (Maybe Integer, Maybe Integer) (Maybe a)
forall a b.
(Ord a, Ord b) =>
Set b -> FSA a (Maybe b) -> FSA a (Maybe b)
tierify (TSLG a -> Set a
forall a. Ord a => TSLG a -> Set a
tslgTier TSLG a
g) (FSA (Maybe Integer, Maybe Integer) (Maybe a)
 -> FSA (Maybe Integer, Maybe Integer) (Maybe a))
-> (SLG a -> FSA (Maybe Integer, Maybe Integer) (Maybe a))
-> SLG a
-> FSA (Maybe Integer, Maybe Integer) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                      (a -> Maybe a)
-> FSA (Maybe Integer, Maybe Integer) a
-> FSA (Maybe Integer, Maybe Integer) (Maybe a)
forall e e1 n.
(Ord e, Ord e1, Ord n) =>
(e -> e1) -> FSA n e -> FSA n e1
renameSymbolsBy a -> Maybe a
forall a. a -> Maybe a
Just (FSA (Maybe Integer, Maybe Integer) a
 -> FSA (Maybe Integer, Maybe Integer) (Maybe a))
-> (SLG a -> FSA (Maybe Integer, Maybe Integer) a)
-> SLG a
-> FSA (Maybe Integer, Maybe Integer) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                      Set a -> FSA Integer a -> FSA (Maybe Integer, Maybe Integer) a
forall a b.
(Ord a, Ord b) =>
Set b -> FSA a b -> FSA (Maybe Integer, Maybe a) b
extendAlphabetTo (TSLG a -> Set a
forall (g :: * -> *) e. HasAlphabet g => g e -> Set e
alphabet TSLG a
g) (FSA Integer a -> FSA (Maybe Integer, Maybe Integer) a)
-> (SLG a -> FSA Integer a)
-> SLG a
-> FSA (Maybe Integer, Maybe Integer) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                      SLG a -> FSA Integer a
forall (g :: * -> *) a.
(Grammar g, NFData a, Ord a) =>
g a -> FSA Integer a
genFSA (SLG a -> FSA Integer a) -> SLG a -> FSA Integer a
forall a b. (a -> b) -> a -> b
$ TSLG a -> SLG a
forall a. Ord a => TSLG a -> SLG a
slgFromTslg TSLG a
g



> gIn :: Ord a => a -> Set (Bool, [a], Bool) -> Set (Bool, [a], Bool)
> gIn :: a -> Set (Bool, [a], Bool) -> Set (Bool, [a], Bool)
gIn a
x = ([a] -> Set [a]) -> Set (Bool, [a], Bool) -> Set (Bool, [a], Bool)
forall a b x y.
(Ord a, Ord b, Ord x, Ord y) =>
(a -> Set b) -> Set (x, a, y) -> Set (x, b, y)
gSet (a -> [a] -> Set [a]
forall a. Ord a => a -> [a] -> Set [a]
putIn a
x)

> putIn :: Ord a => a -> [a] -> Set [a]
> putIn :: a -> [a] -> Set [a]
putIn a
a = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
Set.fromList ([[a]] -> Set [a]) -> ([a] -> [[a]]) -> [a] -> Set [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a] -> [[a]]
forall a. a -> [a] -> [[a]]
putIn' a
a

> putIn' :: a -> [a] -> [[a]]
> putIn' :: a -> [a] -> [[a]]
putIn' a
a [a]
xs = (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:
>               case [a]
xs
>               of []      ->  []
>                  (a
y:[a]
ys)  ->  ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ a -> [a] -> [[a]]
forall a. a -> [a] -> [[a]]
putIn' a
a [a]
ys

> gDrop :: Ord a => a -> Set (Bool, [a], Bool) -> Set (Bool, [a], Bool)
> gDrop :: a -> Set (Bool, [a], Bool) -> Set (Bool, [a], Bool)
gDrop a
x = ([a] -> Set [a]) -> Set (Bool, [a], Bool) -> Set (Bool, [a], Bool)
forall a b x y.
(Ord a, Ord b, Ord x, Ord y) =>
(a -> Set b) -> Set (x, a, y) -> Set (x, b, y)
gSet (a -> [a] -> Set [a]
forall a. Ord a => a -> [a] -> Set [a]
dropOneOf a
x)

> dropOneOf :: Ord a => a -> [a] -> Set [a]
> dropOneOf :: a -> [a] -> Set [a]
dropOneOf a
x = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
Set.fromList ([[a]] -> Set [a]) -> ([a] -> [[a]]) -> [a] -> Set [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a] -> [[a]]
forall a. Eq a => a -> [a] -> [[a]]
dropOneOf' a
x

> dropOneOf' :: Eq a => a -> [a] -> [[a]]
> dropOneOf' :: a -> [a] -> [[a]]
dropOneOf' a
_ [] = []
> dropOneOf' a
a (a
x:[a]
xs)
>     | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
a = [[a]]
ns
>     | Bool
otherwise = [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
ns
>     where ns :: [[a]]
ns = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ a -> [a] -> [[a]]
forall a. Eq a => a -> [a] -> [[a]]
dropOneOf' a
a [a]
xs

> gSet :: (Ord a, Ord b, Ord x, Ord y) =>
>         (a -> Set b) -> Set (x, a, y) -> Set (x, b, y)
> gSet :: (a -> Set b) -> Set (x, a, y) -> Set (x, b, y)
gSet a -> Set b
f = ((x, a, y) -> Set (x, b, y) -> Set (x, b, y))
-> Set (x, b, y) -> Set (x, a, y) -> Set (x, b, y)
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (\(x, a, y)
w -> Set (x, b, y) -> Set (x, b, y) -> Set (x, b, y)
forall c a. Container c a => c -> c -> c
union ((a -> Set b) -> (x, a, y) -> Set (x, b, y)
forall a b x y.
(Ord a, Ord b, Ord x, Ord y) =>
(a -> Set b) -> (x, a, y) -> Set (x, b, y)
gDo a -> Set b
f (x, a, y)
w)) Set (x, b, y)
forall c a. Container c a => c
empty

> gDo :: (Ord a, Ord b, Ord x, Ord y) =>
>        (a -> Set b) -> (x, a, y) -> Set (x, b, y)
> gDo :: (a -> Set b) -> (x, a, y) -> Set (x, b, y)
gDo a -> Set b
f (x
h, a
s, y
t) = (b -> (x, b, y)) -> Set b -> Set (x, b, y)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\b
a -> (x
h, b
a, y
t)) (Set b -> Set (x, b, y)) -> Set b -> Set (x, b, y)
forall a b. (a -> b) -> a -> b
$ a -> Set b
f a
s



> alength :: (Bool, [a], Bool) -> Int
> alength :: (Bool, [a], Bool) -> Int
alength (Bool
h, [a]
s, Bool
t) = Bool -> Int
forall p. Num p => Bool -> p
f Bool
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool -> Int
forall p. Num p => Bool -> p
f Bool
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
s
>     where f :: Bool -> p
f Bool
x = if Bool
x then p
1 else p
0

> ssqis :: Ord a => [a] -> Set (Set a, (Bool, [a], Bool), Set a)
> ssqis :: [a] -> Set (Set a, (Bool, [a], Bool), Set a)
ssqis [a]
xs = [(Set a, (Bool, [a], Bool), Set a)]
-> Set (Set a, (Bool, [a], Bool), Set a)
forall a. Ord a => [a] -> Set a
Set.fromList ([(Set a, (Bool, [a], Bool), Set a)]
 -> Set (Set a, (Bool, [a], Bool), Set a))
-> ([(Set a, (Bool, [a], Bool), Set a)]
    -> [(Set a, (Bool, [a], Bool), Set a)])
-> [(Set a, (Bool, [a], Bool), Set a)]
-> Set (Set a, (Bool, [a], Bool), Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Set a, (Bool, [a], Bool), Set a)
eFF (Set a, (Bool, [a], Bool), Set a)
-> [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
forall a. a -> [a] -> [a]
:) ([(Set a, (Bool, [a], Bool), Set a)]
 -> [(Set a, (Bool, [a], Bool), Set a)])
-> ([(Set a, (Bool, [a], Bool), Set a)]
    -> [(Set a, (Bool, [a], Bool), Set a)])
-> [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Set a, (Bool, [a], Bool), Set a)
eTF (Set a, (Bool, [a], Bool), Set a)
-> [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
forall a. a -> [a] -> [a]
:) ([(Set a, (Bool, [a], Bool), Set a)]
 -> [(Set a, (Bool, [a], Bool), Set a)])
-> ([(Set a, (Bool, [a], Bool), Set a)]
    -> [(Set a, (Bool, [a], Bool), Set a)])
-> [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
forall (c :: * -> *) a.
(Linearizable c, Container (c a) a) =>
c a -> c a -> c a
interleave [(Set a, (Bool, [a], Bool), Set a)]
c ([(Set a, (Bool, [a], Bool), Set a)]
 -> Set (Set a, (Bool, [a], Bool), Set a))
-> [(Set a, (Bool, [a], Bool), Set a)]
-> Set (Set a, (Bool, [a], Bool), Set a)
forall a b. (a -> b) -> a -> b
$ ((Set a, (Bool, [a], Bool), Set a)
 -> (Set a, (Bool, [a], Bool), Set a))
-> [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
forall a b. (a -> b) -> [a] -> [b]
map (Set a, (Bool, [a], Bool), Set a)
-> (Set a, (Bool, [a], Bool), Set a)
forall a a b c c. (a, (a, b, c), c) -> (a, (Bool, b, c), c)
f [(Set a, (Bool, [a], Bool), Set a)]
o
>     where f :: (a, (a, b, c), c) -> (a, (Bool, b, c), c)
f (a
a, (a
_, b
y, c
z), c
b) = (a
a, (Bool
True, b
y, c
z), c
b)
>           ([(Set a, (Bool, [a], Bool), Set a)]
c, [(Set a, (Bool, [a], Bool), Set a)]
o) = [a]
-> ([(Set a, (Bool, [a], Bool), Set a)],
    [(Set a, (Bool, [a], Bool), Set a)])
forall a.
Ord a =>
[a]
-> ([(Set a, (Bool, [a], Bool), Set a)],
    [(Set a, (Bool, [a], Bool), Set a)])
ssqis' [a]
xs
>           eFF :: (Set a, (Bool, [a], Bool), Set a)
eFF = (Set a
forall c a. Container c a => c
empty, (Bool
False, [a]
forall c a. Container c a => c
empty, Bool
False), Set a
forall c a. Container c a => c
empty)
>           eTF :: (Set a, (Bool, [a], Bool), Set a)
eTF = (Set a
forall c a. Container c a => c
empty, (Bool
True, [a]
forall c a. Container c a => c
empty, Bool
False), Set a
forall c a. Container c a => c
empty)

The output of the @ssqis'@ function is a pair, each component of which
is a triple listing the elements taken, the subsequence proper,
and the skipped elements, respectively.
The first component of the outer pair
is the complete subsequence-intervener structures,
where no elements prior to the beginning of the subsequence
are listed as skipped.
The other component lists those structures
that still need a beginning to be complete.

> ssqis' :: Ord a => [a]
>        -> ( [(Set a, (Bool, [a], Bool), Set a)]
>           , [(Set a, (Bool, [a], Bool), Set a)]
>           )
> ssqis' :: [a]
-> ([(Set a, (Bool, [a], Bool), Set a)],
    [(Set a, (Bool, [a], Bool), Set a)])
ssqis' []      =  ([(Set a, (Bool, [a], Bool), Set a)]
forall a. [(Set a, (Bool, [a], Bool), Set a)]
tailFish, [(Set a, (Bool, [a], Bool), Set a)]
forall a. [(Set a, (Bool, [a], Bool), Set a)]
tailFish)
>     where tailFish :: [(Set a, (Bool, [a], Bool), Set a)]
tailFish = [(Set a
forall c a. Container c a => c
empty, (Bool
False, [], Bool
True), Set a
forall c a. Container c a => c
empty)]
> ssqis' (a
x:[a]
xs)  =  ( (a -> Set a
forall c a. Container c a => a -> c
singleton a
x, a -> (Bool, [a], Bool)
forall a. a -> (Bool, [a], Bool)
e a
x, Set a
forall c a. Container c a => c
empty) (Set a, (Bool, [a], Bool), Set a)
-> [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
forall a. a -> [a] -> [a]
: [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
forall (c :: * -> *) a.
(Linearizable c, Container (c a) a) =>
c a -> c a -> c a
interleave [(Set a, (Bool, [a], Bool), Set a)]
c [(Set a, (Bool, [a], Bool), Set a)]
took
>                   , (a -> Set a
forall c a. Container c a => a -> c
singleton a
x, a -> (Bool, [a], Bool)
forall a. a -> (Bool, [a], Bool)
e a
x, Set a
forall c a. Container c a => c
empty) (Set a, (Bool, [a], Bool), Set a)
-> [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
forall a. a -> [a] -> [a]
: [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
forall (c :: * -> *) a.
(Linearizable c, Container (c a) a) =>
c a -> c a -> c a
interleave [(Set a, (Bool, [a], Bool), Set a)]
skips [(Set a, (Bool, [a], Bool), Set a)]
took
>                   )
>     where ([(Set a, (Bool, [a], Bool), Set a)]
c, [(Set a, (Bool, [a], Bool), Set a)]
o) =  [a]
-> ([(Set a, (Bool, [a], Bool), Set a)],
    [(Set a, (Bool, [a], Bool), Set a)])
forall a.
Ord a =>
[a]
-> ([(Set a, (Bool, [a], Bool), Set a)],
    [(Set a, (Bool, [a], Bool), Set a)])
ssqis' [a]
xs
>           took :: [(Set a, (Bool, [a], Bool), Set a)]
took   =  ((Set a, (Bool, [a], Bool), Set a)
 -> [(Set a, (Bool, [a], Bool), Set a)]
 -> [(Set a, (Bool, [a], Bool), Set a)])
-> [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Set a, (Bool, [a], Bool), Set a)
-> [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
forall c a a c.
(Container c a, Container a a) =>
(a, (a, [a], c), c)
-> [(a, (a, [a], c), c)] -> [(a, (a, [a], c), c)]
f [] [(Set a, (Bool, [a], Bool), Set a)]
o
>           skips :: [(Set a, (Bool, [a], Bool), Set a)]
skips  =  ((Set a, (Bool, [a], Bool), Set a)
 -> [(Set a, (Bool, [a], Bool), Set a)]
 -> [(Set a, (Bool, [a], Bool), Set a)])
-> [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Set a, (Bool, [a], Bool), Set a)
-> [(Set a, (Bool, [a], Bool), Set a)]
-> [(Set a, (Bool, [a], Bool), Set a)]
forall a c b.
(Container a a, Container c a) =>
(a, b, c) -> [(a, b, c)] -> [(a, b, c)]
g [] [(Set a, (Bool, [a], Bool), Set a)]
o
>           f :: (a, (a, [a], c), c)
-> [(a, (a, [a], c), c)] -> [(a, (a, [a], c), c)]
f (a
r,(a, [a], c)
s,c
t) [(a, (a, [a], c), c)]
w  =  if c -> a -> Bool
forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn c
t a
x
>                           then [(a, (a, [a], c), c)]
w
>                           else (a -> a -> a
forall c a. Container c a => a -> c -> c
insert a
x a
r, a -> (a, [a], c) -> (a, [a], c)
forall a a c. a -> (a, [a], c) -> (a, [a], c)
h a
x (a, [a], c)
s, c
t) (a, (a, [a], c), c)
-> [(a, (a, [a], c), c)] -> [(a, (a, [a], c), c)]
forall a. a -> [a] -> [a]
: [(a, (a, [a], c), c)]
w
>           g :: (a, b, c) -> [(a, b, c)] -> [(a, b, c)]
g (a
r,b
s,c
t) [(a, b, c)]
w  =  if a -> a -> Bool
forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn a
r a
x
>                           then [(a, b, c)]
w
>                           else (a
r, b
s, a -> c -> c
forall c a. Container c a => a -> c -> c
insert a
x c
t) (a, b, c) -> [(a, b, c)] -> [(a, b, c)]
forall a. a -> [a] -> [a]
: [(a, b, c)]
w
>           h :: a -> (a, [a], c) -> (a, [a], c)
h a
a (a
r,[a]
s,c
t)  =  (a
r, a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
s, c
t)
>           e :: a -> (Bool, [a], Bool)
e a
a = (Bool
False, [a
a], Bool
False)