msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

Finite state networks: replace some lookup tables with maps. Rewrite closure for speed.

Browse Source
This commit is contained in:
bringert
2005-12-29 16:29:21 +00:00
parent 5ad1ca8827
commit f4f1f04123
2 changed files with 17 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
src/GF/Speech/CFGToFiniteState.hs
View File

@@ -130,8 +130,10 @@ make_fa c@(g,ns) q0 alpha q1 fa =
fa''' = foldl (\f (CFRule c (Cat d:xs) _) -> make_fa_ (getState d) xs (getState c) f) fa'' rs fa''' = foldl (\f (CFRule c (Cat d:xs) _) -> make_fa_ (getState d) xs (getState c) f) fa'' rs
in newTransition (getState a) q1 Nothing fa''' in newTransition (getState a) q1 Nothing fa'''
where where
(fa',ss) = addStatesForCats ni fa (fa',stateMap) = addStatesForCats ni fa
getState x = lookup' x ss getState x = Map.findWithDefault
(error $ "CFGToFiniteState: No state for " ++ x)
x stateMap
-- a is not recursive -- a is not recursive
Nothing -> let rs = catRules g a Nothing -> let rs = catRules g a
in foldl (\fa -> \ (CFRule _ b _) -> make_fa_ q0 b q1 fa) fa rs in foldl (\fa -> \ (CFRule _ b _) -> make_fa_ q0 b q1 fa) fa rs
@@ -140,9 +142,10 @@ make_fa c@(g,ns) q0 alpha q1 fa =
where where
make_fa_ = make_fa c make_fa_ = make_fa c
addStatesForCats :: [Cat_] -> NFA Token -> (NFA Token, [(Cat_,State)]) addStatesForCats :: [Cat_] -> NFA Token -> (NFA Token, Map Cat_ State)
addStatesForCats cs fa = (fa', zip cs (map fst ns)) addStatesForCats cs fa = (fa', m)
where (fa', ns) = newStates (replicate (length cs) ()) fa where (fa', ns) = newStates (replicate (length cs) ()) fa
m = Map.fromList (zip cs (map fst ns))
ruleIsNonRecursive :: Set Cat_ -> CFRule_ -> Bool ruleIsNonRecursive :: Set Cat_ -> CFRule_ -> Bool
ruleIsNonRecursive cs = noCatsInSet cs . ruleRhs ruleIsNonRecursive cs = noCatsInSet cs . ruleRhs

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

@@ -152,16 +152,21 @@ determinize (FA g s f) = let (ns,es) = h [start] [] []
numberStates :: (Ord x,Enum y) => FA x a b -> FA y a b numberStates :: (Ord x,Enum y) => FA x a b -> FA y a b
numberStates (FA g s fs) = FA (renameNodes newName rest g) s' fs' numberStates (FA g s fs) = FA (renameNodes newName rest g) s' fs'
where (ns,rest) = splitAt (length (nodes g)) $ [toEnum 0 .. ] where (ns,rest) = splitAt (length (nodes g)) $ [toEnum 0 .. ]
newNodes = zip (map fst (nodes g)) ns newNodes = Map.fromList (zip (map fst (nodes g)) ns)
newName n = lookup' n newNodes newName n = Map.findWithDefault (error "FiniteState.newName") n newNodes
s' = newName s s' = newName s
fs' = map newName fs fs' = map newName fs
-- | Get all the nodes reachable from a list of nodes by only empty edges. -- | Get all the nodes reachable from a list of nodes by only empty edges.
closure :: Ord n => Outgoing n a (Maybe b) -> Set n -> Set n closure :: Ord n => Outgoing n a (Maybe b) -> Set n -> Set n
closure out = fix closure_ closure out x = closure_ x x
where closure_ r = inserts [y | x <- Set.toList r, (_,y,Nothing) <- getOutgoing out x] r where closure_ acc check | Set.null check = acc
inserts xs s = foldl (flip Set.insert) s xs | otherwise = closure_ acc' check'
where
reach = Set.fromList [y | x <- Set.toList check,
(_,y,Nothing) <- getOutgoing out x]
acc' = acc `Set.union` reach
check' = reach Set.\\ acc
-- | Get a map of labels to sets of all nodes reachable -- | Get a map of labels to sets of all nodes reachable
-- from a the set of nodes by one edge with the given -- from a the set of nodes by one edge with the given