> {-# OPTIONS_HADDOCK show-extensions #-}
> {-|
> Module    : LTK.Learn.TSL.AugmentedSubsequences
> Copyright : (c) 2019-2020,2023 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 :: forall a. Ord a => Int -> [a] -> TSLG a
fTSL Int
k [a]
w = TSLG { tslgAlpha :: Set a
tslgAlpha  =  Set a
as
>                 , tslgInf :: Bool
tslgInf    =  Bool
inf
>                 , tslgK :: Int
tslgK      =  Int
k
>                 , tslgF :: SLG a
tslgF      =  forall a. Ord a => Int -> [a] -> SLG a
fSL Int
k [a]
w
>                 , tslgFp1 :: SLG a
tslgFp1    =  forall a. Ord a => Int -> [a] -> SLG a
fSL (Int
k 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   =  forall (s :: * -> *) a.
(Collapsible s, Container (s a) a) =>
(a -> Bool) -> s a -> s a
keep (\(Set a
_,(Bool, [a], Bool)
b,Set a
_) -> forall {a}. (Bool, [a], Bool) -> Bool
f (Bool, [a], Bool)
b) forall a b. (a -> b) -> a -> b
$ 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 = 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 forall a. Ord a => a -> a -> Bool
<= Int
k) Bool -> Bool -> Bool
|| Int
a forall a. Eq a => a -> a -> Bool
== Int
k
>           as :: Set a
as   =  forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (forall c a. Container c a => c -> c -> c
union forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Set a
a,(Bool, [a], Bool)
_,Set a
_) -> Set a
a)) forall c a. Container c a => c
empty Set (Set a, (Bool, [a], Bool), Set a)
fs
>           inf :: Bool
inf  =  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 :: forall a. Ord a => TSLG a -> Set a
tslgTier TSLG a
g = forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
n) (forall (g :: * -> *) e. HasAlphabet g => g e -> Set e
alphabet TSLG a
g)
>     where n :: a -> Bool
n   = forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
both a -> Bool
r a -> Bool
p
>           r :: a -> Bool
r a
x = forall c a. (Container c a, Eq a) => c -> c -> Bool
isSubsetOf (forall a. SLG a -> Set (Bool, [a], Bool)
slg forall a b. (a -> b) -> a -> b
$ forall a. TSLG a -> SLG a
tslgF TSLG a
g) forall a b. (a -> b) -> a -> b
$ forall a.
Ord a =>
a -> Set (Bool, [a], Bool) -> Set (Bool, [a], Bool)
gDrop a
x (forall a. SLG a -> Set (Bool, [a], Bool)
slg forall a b. (a -> b) -> a -> b
$ forall a. TSLG a -> SLG a
tslgFp1 TSLG a
g)
>           p :: a -> Bool
p a
x = forall c a. (Container c a, Eq a) => c -> c -> Bool
isSubsetOf (forall a. SLG a -> Set (Bool, [a], Bool)
slg forall a b. (a -> b) -> a -> b
$ forall a. TSLG a -> SLG a
tslgFp1 TSLG a
g) forall a b. (a -> b) -> a -> b
$ forall a.
Ord a =>
a -> Set (Bool, [a], Bool) -> Set (Bool, [a], Bool)
gIn a
x (forall a. SLG a -> Set (Bool, [a], Bool)
slg forall a b. (a -> b) -> a -> b
$ forall a. TSLG a -> SLG a
tslgF TSLG a
g)

> slgFromTslg :: Ord a => TSLG a -> SLG a
> slgFromTslg :: forall a. Ord a => TSLG a -> SLG a
slgFromTslg TSLG a
g = SLG { slgAlpha :: Set a
slgAlpha = Set a
t
>                     , slgK :: Int
slgK = forall a. TSLG a -> Int
tslgK TSLG a
g
>                     , slg :: Set (Bool, [a], Bool)
slg = forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall {a} {b} {c}. (a, b, c) -> b
ex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Set a -> Set a
Set.filter forall {b}. (Set a, b, Set a) -> Bool
f forall a b. (a -> b) -> a -> b
$ forall a. TSLG a -> Set (Set a, (Bool, [a], Bool), Set a)
tslg TSLG a
g
>                     }
>     where t :: Set a
t = 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) = forall c a. (Container c a, Eq a) => c -> c -> Bool
isSubsetOf Set a
t Set a
x Bool -> Bool -> Bool
&&
>                         forall a. Set a -> Bool
Set.null (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 { forall a. TSLG a -> Set a
tslgAlpha :: Set a
>                    , forall a. TSLG a -> Bool
tslgInf :: Bool
>                    , forall a. TSLG a -> Int
tslgK :: Int
>                    , forall a. TSLG a -> SLG a
tslgF :: SLG a
>                    , forall a. TSLG a -> SLG a
tslgFp1 :: SLG a
>                    , forall 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
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, TSLG a -> TSLG a -> Bool
TSLG a -> TSLG a -> 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 {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
Ord, ReadPrec [TSLG a]
ReadPrec (TSLG a)
ReadS [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
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 :: forall a. TSLG a -> Set a
alphabet = forall a. TSLG a -> Set a
tslgAlpha

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

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

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

> gDrop :: Ord a => a -> Set (Bool, [a], Bool) -> Set (Bool, [a], Bool)
> gDrop :: forall a.
Ord a =>
a -> Set (Bool, [a], Bool) -> Set (Bool, [a], Bool)
gDrop a
x = 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 (forall a. Ord a => a -> [a] -> Set [a]
dropOneOf a
x)

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

> dropOneOf' :: Eq a => a -> [a] -> [[a]]
> dropOneOf' :: forall a. Eq a => a -> [a] -> [[a]]
dropOneOf' a
_ [] = []
> dropOneOf' a
a (a
x:[a]
xs)
>     | a
x forall a. Eq a => a -> a -> Bool
/= a
a = [[a]]
ns
>     | Bool
otherwise = [a]
xs forall a. a -> [a] -> [a]
: [[a]]
ns
>     where ns :: [[a]]
ns = forall a b. (a -> b) -> [a] -> [b]
map (a
x forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ 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 :: 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 -> Set b
f = forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (forall c a. Container c a => c -> c -> c
union forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) 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 :: 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
h, a
s, y
t) = forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\b
a -> (x
h, b
a, y
t)) forall a b. (a -> b) -> a -> b
$ a -> Set b
f a
s



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

> ssqis :: Ord a => [a] -> Set (Set a, (Bool, [a], Bool), Set a)
> ssqis :: forall a. Ord a => [a] -> Set (Set a, (Bool, [a], Bool), Set a)
ssqis [a]
xs = forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Set a, (Bool, [a], Bool), Set a)
eFF forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Set a, (Bool, [a], Bool), Set a)
eTF forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) a.
(Linearizable c, Container (c a) a) =>
c a -> c a -> c a
interleave [(Set a, (Bool, [a], Bool), Set a)]
c forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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) = 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 = (forall c a. Container c a => c
empty, (Bool
False, forall c a. Container c a => c
empty, Bool
False), forall c a. Container c a => c
empty)
>           eTF :: (Set a, (Bool, [a], Bool), Set a)
eTF = (forall c a. Container c a => c
empty, (Bool
True, forall c a. Container c a => c
empty, Bool
False), 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' :: forall a.
Ord a =>
[a]
-> ([(Set a, (Bool, [a], Bool), Set a)],
    [(Set a, (Bool, [a], Bool), Set a)])
ssqis' []      =  (forall {a}. [(Set a, (Bool, [a], Bool), Set a)]
tailFish, forall {a}. [(Set a, (Bool, [a], Bool), Set a)]
tailFish)
>     where tailFish :: [(Set a, (Bool, [a], Bool), Set a)]
tailFish = [(forall c a. Container c a => c
empty, (Bool
False, [], Bool
True), forall c a. Container c a => c
empty)]
> ssqis' (a
x:[a]
xs)  =  ( (forall c a. Container c a => a -> c
singleton a
x, forall {a}. a -> (Bool, [a], Bool)
e a
x, forall c a. Container c a => c
empty) forall a. a -> [a] -> [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
>                   , (forall c a. Container c a => a -> c
singleton a
x, forall {a}. a -> (Bool, [a], Bool)
e a
x, forall c a. Container c a => c
empty) forall a. a -> [a] -> [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) =  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   =  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 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  =  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 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 forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn c
t a
x
>                           then [(a, (a, [a], c), c)]
w
>                           else (forall c a. Container c a => a -> c -> c
insert a
x a
r, forall {a} {a} {c}. a -> (a, [a], c) -> (a, [a], c)
h a
x (a, [a], c)
s, c
t) 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 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, forall c a. Container c a => a -> c -> c
insert a
x c
t) 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 forall a. a -> [a] -> [a]
: [a]
s, c
t)
>           e :: a -> (Bool, [a], Bool)
e a
a = (Bool
False, [a
a], Bool
False)