> {-# OPTIONS_HADDOCK show-extensions #-}
>
> module LTK.Learn.TSL.ViaSL(TSLG, fTSL) where
> import Data.Set (Set)
> import qualified Data.Set as Set
> import LTK.FSA
> import LTK.Learn.StringExt
> import LTK.Learn.SL
>
> fTSL :: Ord a => Int -> [a] -> TSLG a
> fTSL :: forall a. Ord a => Int -> [a] -> TSLG a
fTSL Int
k [a]
w = TSLG { tslGK :: SLG a
tslGK = Int -> [a] -> SLG a
forall a. Ord a => Int -> [a] -> SLG a
fSL Int
k [a]
w, tslGK1 :: SLG a
tslGK1 = 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 }
> tslgTier :: Ord a => TSLG a -> Set a
> tslgTier :: forall a. Ord a => 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 e. TSLG e -> Set e
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
tslGK 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
tslGK1 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
tslGK1 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
tslGK 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 = SLG a -> Int
forall a. SLG a -> Int
slgK SLG a
gk
> , slg :: Set (Bool, [a], Bool)
slg = ((Bool, [a], Bool) -> Bool)
-> Set (Bool, [a], Bool) -> Set (Bool, [a], Bool)
forall (s :: * -> *) a.
(Collapsible s, Container (s a) a) =>
(a -> Bool) -> s a -> s a
keep (Bool, [a], Bool) -> Bool
forall {t :: * -> *} {a} {c}. Foldable t => (a, t a, c) -> Bool
f (SLG a -> Set (Bool, [a], Bool)
forall a. SLG a -> Set (Bool, [a], Bool)
slg SLG a
gk)
> }
> where gk :: SLG a
gk = TSLG a -> SLG a
forall a. TSLG a -> SLG a
tslGK TSLG a
g
> t :: Set a
t = TSLG a -> Set a
forall a. Ord a => TSLG a -> Set a
tslgTier TSLG a
g
> f :: (a, t a, c) -> Bool
f (a
_, t a
a, c
_) = (a -> Bool) -> t a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Set a -> a -> Bool
forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn Set a
t) t a
a
>
> data TSLG a = TSLG { forall a. TSLG a -> SLG a
tslGK :: SLG a, forall a. TSLG a -> SLG a
tslGK1 :: SLG 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
$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
/= :: 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
$ccompare :: forall a. Ord a => TSLG a -> TSLG a -> Ordering
compare :: TSLG a -> TSLG a -> Ordering
$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
>= :: TSLG a -> TSLG a -> Bool
$cmax :: forall a. Ord a => TSLG a -> TSLG a -> TSLG a
max :: TSLG a -> TSLG a -> TSLG a
$cmin :: forall a. Ord a => TSLG a -> TSLG a -> TSLG a
min :: TSLG a -> TSLG a -> 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
$creadsPrec :: forall a. (Read a, Ord a) => Int -> ReadS (TSLG a)
readsPrec :: Int -> ReadS (TSLG a)
$creadList :: forall a. (Read a, Ord a) => ReadS [TSLG a]
readList :: ReadS [TSLG a]
$creadPrec :: forall a. (Read a, Ord a) => ReadPrec (TSLG a)
readPrec :: ReadPrec (TSLG a)
$creadListPrec :: forall a. (Read a, Ord a) => ReadPrec [TSLG a]
readListPrec :: ReadPrec [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
$cshowsPrec :: forall a. Show a => Int -> TSLG a -> ShowS
showsPrec :: Int -> TSLG a -> ShowS
$cshow :: forall a. Show a => TSLG a -> String
show :: TSLG a -> String
$cshowList :: forall a. Show a => [TSLG a] -> ShowS
showList :: [TSLG a] -> ShowS
Show)
> instance HasAlphabet TSLG
> where alphabet :: forall e. TSLG e -> Set e
alphabet = SLG e -> Set e
forall e. SLG e -> Set e
forall (g :: * -> *) e. HasAlphabet g => g e -> Set e
alphabet (SLG e -> Set e) -> (TSLG e -> SLG e) -> TSLG e -> Set e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TSLG e -> SLG e
forall a. TSLG a -> SLG a
tslGK1
> instance Grammar TSLG
> where emptyG :: forall a. Ord a => TSLG a
emptyG = SLG a -> SLG a -> TSLG a
forall a. SLG a -> SLG a -> TSLG a
TSLG SLG a
forall a. Ord a => SLG a
forall (g :: * -> *) a. (Grammar g, Ord a) => g a
emptyG SLG a
forall a. Ord a => SLG a
forall (g :: * -> *) a. (Grammar g, Ord a) => g a
emptyG
> augmentG :: forall a. Ord a => TSLG a -> TSLG a -> TSLG a
augmentG TSLG a
g1 TSLG a
g2
> = TSLG { tslGK :: SLG a
tslGK = SLG a -> SLG a -> SLG a
forall a. Ord a => 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
tslGK TSLG a
g1) (TSLG a -> SLG a
forall a. TSLG a -> SLG a
tslGK TSLG a
g2)
> , tslGK1 :: SLG a
tslGK1 = SLG a -> SLG a -> SLG a
forall a. Ord a => 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
tslGK1 TSLG a
g1) (TSLG a -> SLG a
forall a. TSLG a -> SLG a
tslGK1 TSLG a
g2)}
> isSubGOf :: forall a. Ord a => TSLG a -> TSLG a -> Bool
isSubGOf TSLG a
g1 TSLG a
g2 = SLG a -> SLG a -> Bool
forall a. Ord a => SLG a -> SLG a -> Bool
forall (g :: * -> *) a. (Grammar g, Ord a) => g a -> g a -> Bool
isSubGOf (TSLG a -> SLG a
forall a. TSLG a -> SLG a
tslGK TSLG a
g1) (TSLG a -> SLG a
forall a. TSLG a -> SLG a
tslGK TSLG a
g2)
> Bool -> Bool -> Bool
&& SLG a -> SLG a -> Bool
forall a. Ord a => SLG a -> SLG a -> Bool
forall (g :: * -> *) a. (Grammar g, Ord a) => g a -> g a -> Bool
isSubGOf (TSLG a -> SLG a
forall a. TSLG a -> SLG a
tslGK1 TSLG a
g1) (TSLG a -> SLG a
forall a. TSLG a -> SLG a
tslGK1 TSLG a
g2)
> genFSA :: forall a. (NFData a, Ord a) => 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 e. TSLG e -> Set e
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 a. (NFData a, Ord a) => 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 :: forall a.
Ord a =>
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 :: forall a. Ord a => 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' :: forall a. 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 :: forall a.
Ord a =>
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 :: forall a. Ord a => 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' :: forall a. Eq a => 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 :: 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 = ((x, a, y) -> Set (x, b, y) -> Set (x, b, y))
-> Set (x, b, y) -> Set (x, a, y) -> Set (x, b, y)
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (Set (x, b, y) -> Set (x, b, y) -> Set (x, b, y)
forall c a. Container c a => c -> c -> c
union (Set (x, b, y) -> Set (x, b, y) -> Set (x, b, y))
-> ((x, a, y) -> Set (x, b, y))
-> (x, a, y)
-> Set (x, b, y)
-> Set (x, b, y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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) 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 :: 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) = (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