GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-12 04:32:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

Finite state network generation: reimplemented getOutgoing using Data.Map to improve performance of minimize with large networks.

Browse Source
This commit is contained in:
bringert
2005-12-29 13:33:58 +00:00
parent e32472a9bb
commit cb5e52bd2e
2 changed files with 22 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
src/GF/Speech/FiniteState.hs
View File

@@ -103,7 +103,7 @@ oneFinalState nl el fa =
moveLabelsToNodes :: (Ord n,Eq a) => FA n () (Maybe a) -> FA n (Maybe a) ()
moveLabelsToNodes = removeTrivialEmptyNodes . onGraph f
where f gr@(Graph c _ _) = Graph c' ns (concat ess)
where is = incoming gr
where is = incomingToList $ incoming gr
(c',is') = mapAccumL fixIncoming c is
(ns,ess) = unzip (concat is')
@@ -112,7 +112,7 @@ moveLabelsToNodes = removeTrivialEmptyNodes . onGraph f
removeTrivialEmptyNodes :: FA n (Maybe a) () -> FA n (Maybe a) ()
removeTrivialEmptyNodes = id -- FIXME: implement
fixIncoming :: (Eq n, Eq a) => [n] -> (Node n (),[Edge n (Maybe a)]) -> ([n],[(Node n (Maybe a),[Edge n ()])])
fixIncoming :: (Ord n, Eq a) => [n] -> (Node n (),[Edge n (Maybe a)]) -> ([n],[(Node n (Maybe a),[Edge n ()])])
fixIncoming cs c@((n,()),es) = (cs'', ((n,Nothing),es'):newContexts)
where ls = nub $ map getLabel es
(cs',cs'') = splitAt (length ls) cs
@@ -156,7 +156,7 @@ numberStates (FA g s fs) = FA (renameNodes newName rest g) s' fs'
fs' = map newName fs
-- | Get all the nodes reachable from a set of nodes by only empty edges.
closure :: Eq n => Outgoing n a (Maybe b) -> [n] -> [n]
closure :: Ord n => Outgoing n a (Maybe b) -> [n] -> [n]
closure out = fix closure_
where closure_ r = r `union` [y | x <- r, (_,y,Nothing) <- getOutgoing out x]