> {-# OPTIONS_HADDOCK show-extensions #-}
> {-|
> Module : LTK.Porters.Corpus
> Copyright : (c) 2019-2020,2023 Dakotah Lambert
> LICENSE : MIT
> 
> This module provides methods to construct
> prefix-trees of corpora.
>
> @since 0.3
> -}
> module LTK.Porters.Corpus (readCorpus) where

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

> import LTK.FSA

> -- |Construct a prefix-tree of a (finite) corpus.
> 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)