> {-# 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 = forall {a} {e}.
Ord a =>
(Set e, Set (Transition [a] e), Set (State [a])) -> FSA [a] e
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a.
Ord a =>
[a]
-> (Set a, Set (Transition [a] a), Set (State [a]))
-> (Set a, Set (Transition [a] a), Set (State [a]))
addWord (forall c a. Container c a => c
empty, forall c a. Container c a => c
empty, 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 = forall c a. Container c a => a -> c
singleton forall a b. (a -> b) -> a -> b
$ 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)
>     = ( forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse forall c a. Container c a => a -> c -> c
insert Set a
alpha [a]
w
>       , Set (Transition [a] a)
trans forall c a. Container c a => c -> c -> c
`union` Set (Transition [a] a)
trans'
>       , forall c a. Container c a => a -> c -> c
insert (forall n. n -> State n
State [a]
w) Set (State [a])
fin
>       )
>     where trans' :: Set (Transition [a] a)
trans' = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall {a} {e}. [a] -> [e] -> [Transition a e]
f (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 = forall e. e -> Symbol e
Symbol e
z
>                 , source :: State a
source = forall n. n -> State n
State a
x
>                 , destination :: State a
destination = forall n. n -> State n
State a
y
>                 } forall a. a -> [a] -> [a]
: [a] -> [e] -> [Transition a e]
f (a
yforall a. a -> [a] -> [a]
:[a]
xs) [e]
zs
>           f [a]
_ [e]
_ = []
>           inits :: [a] -> [[a]]
inits [a]
xs = [] forall a. a -> [a] -> [a]
:
>                      case [a]
xs
>                      of []      ->  []
>                         (a
a:[a]
as)  ->  forall a b. (a -> b) -> [a] -> [b]
map (a
a forall a. a -> [a] -> [a]
:) ([a] -> [[a]]
inits [a]
as)