> {-# OPTIONS_HADDOCK show-extensions #-}
>
> module LTK.Porters.Corpus (readCorpus) where
> import Data.Set (Set)
> import qualified Data.Set as Set
> import LTK.FSA
>
> readCorpus :: Ord a => [[a]] -> FSA [a] a
> readCorpus :: forall a. Ord a => [[a]] -> FSA [a] a
readCorpus = (Set a, Set (Transition [a] a), Set (State [a])) -> FSA [a] a
forall {a} {e}.
Ord a =>
(Set e, Set (Transition [a] e), Set (State [a])) -> FSA [a] e
f ((Set a, Set (Transition [a] a), Set (State [a])) -> FSA [a] a)
-> ([[a]] -> (Set a, Set (Transition [a] a), Set (State [a])))
-> [[a]]
-> FSA [a] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a]
-> (Set a, Set (Transition [a] a), Set (State [a]))
-> (Set a, Set (Transition [a] a), Set (State [a])))
-> (Set a, Set (Transition [a] a), Set (State [a]))
-> [[a]]
-> (Set a, Set (Transition [a] a), Set (State [a]))
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [a]
-> (Set a, Set (Transition [a] a), Set (State [a]))
-> (Set a, Set (Transition [a] a), Set (State [a]))
forall a.
Ord a =>
[a]
-> (Set a, Set (Transition [a] a), Set (State [a]))
-> (Set a, Set (Transition [a] a), Set (State [a]))
addWord (Set a
forall c a. Container c a => c
empty, Set (Transition [a] a)
forall c a. Container c a => c
empty, Set (State [a])
forall c a. Container c a => c
empty)
> where f :: (Set e, Set (Transition [a] e), Set (State [a])) -> FSA [a] e
f (Set e
alpha, Set (Transition [a] e)
trans, Set (State [a])
fin)
> = FSA
> { sigma :: Set e
sigma = Set e
alpha
> , transitions :: Set (Transition [a] e)
transitions = Set (Transition [a] e)
trans
> , initials :: Set (State [a])
initials = State [a] -> Set (State [a])
forall c a. Container c a => a -> c
singleton (State [a] -> Set (State [a])) -> State [a] -> Set (State [a])
forall a b. (a -> b) -> a -> b
$ [a] -> State [a]
forall n. n -> State n
State []
> , finals :: Set (State [a])
finals = Set (State [a])
fin
> , isDeterministic :: Bool
isDeterministic = Bool
False
> }
> addWord :: (Ord a) =>
> [a] -> (Set a, Set (Transition [a] a), Set (State [a])) ->
> (Set a, Set (Transition [a] a), Set (State [a]))
> addWord :: forall a.
Ord a =>
[a]
-> (Set a, Set (Transition [a] a), Set (State [a]))
-> (Set a, Set (Transition [a] a), Set (State [a]))
addWord [a]
w (Set a
alpha, Set (Transition [a] a)
trans, Set (State [a])
fin)
> = ( (a -> Set a -> Set a) -> Set a -> [a] -> Set a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse a -> Set a -> Set a
forall c a. Container c a => a -> c -> c
insert Set a
alpha [a]
w
> , Set (Transition [a] a)
trans Set (Transition [a] a)
-> Set (Transition [a] a) -> Set (Transition [a] a)
forall c a. Container c a => c -> c -> c
`union` Set (Transition [a] a)
trans'
> , State [a] -> Set (State [a]) -> Set (State [a])
forall c a. Container c a => a -> c -> c
insert ([a] -> State [a]
forall n. n -> State n
State [a]
w) Set (State [a])
fin
> )
> where trans' :: Set (Transition [a] a)
trans' = [Transition [a] a] -> Set (Transition [a] a)
forall a. Ord a => [a] -> Set a
Set.fromList ([Transition [a] a] -> Set (Transition [a] a))
-> [Transition [a] a] -> Set (Transition [a] a)
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a] -> [Transition [a] a]
forall {a} {e}. [a] -> [e] -> [Transition a e]
f ([a] -> [[a]]
forall {a}. [a] -> [[a]]
inits [a]
w) [a]
w
> f :: [a] -> [e] -> [Transition a e]
f (a
x:a
y:[a]
xs) (e
z:[e]
zs)
> = Transition
> { edgeLabel :: Symbol e
edgeLabel = e -> Symbol e
forall e. e -> Symbol e
Symbol e
z
> , source :: State a
source = a -> State a
forall n. n -> State n
State a
x
> , destination :: State a
destination = a -> State a
forall n. n -> State n
State a
y
> } Transition a e -> [Transition a e] -> [Transition a e]
forall a. a -> [a] -> [a]
: [a] -> [e] -> [Transition a e]
f (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [e]
zs
> f [a]
_ [e]
_ = []
> inits :: [a] -> [[a]]
inits [a]
xs = [] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:
> case [a]
xs
> of [] -> []
> (a
a:[a]
as) -> ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [[a]]
inits [a]
as)