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

Reduced complexity of reachable in FA determinization.

Browse Source
This commit is contained in:
bringert
2005-10-27 08:16:30 +00:00
parent 8b1821e8ae
commit aef17a14c4
1 changed files with 14 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/10/26 17:13:13 $ -- > CVS $Date: 2005/10/27 09:16:30 $
-- > CVS $Author: bringert $ -- > CVS $Author: bringert $
-- > CVS $Revision: 1.14 $ -- > CVS $Revision: 1.15 $
-- --
-- A simple finite state network module. -- A simple finite state network module.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -23,6 +23,8 @@ module GF.Speech.FiniteState (FA, State, NFA, DFA,
import Data.List import Data.List
import Data.Maybe (catMaybes,fromJust) import Data.Maybe (catMaybes,fromJust)
import Data.Map (Map)
import qualified Data.Map as Map
import GF.Data.Utilities import GF.Data.Utilities
import GF.Speech.Graph import GF.Speech.Graph
@@ -70,10 +72,9 @@ mapStates f = onGraph (nmap f)
mapTransitions :: (b -> c) -> FA n a b -> FA n a c mapTransitions :: (b -> c) -> FA n a b -> FA n a c
mapTransitions f = onGraph (emap f) mapTransitions f = onGraph (emap f)
minimize :: Eq a => NFA a -> NFA a minimize :: Ord a => NFA a -> NFA a
minimize = dfa2nfa . determinize . reverseNFA . dfa2nfa . determinize . reverseNFA minimize = dfa2nfa . determinize . reverseNFA . dfa2nfa . determinize . reverseNFA
onGraph :: (Graph n a b -> Graph n c d) -> FA n a b -> FA n c d onGraph :: (Graph n a b -> Graph n c d) -> FA n a b -> FA n c d
onGraph f (FA g s ss) = FA (f g) s ss onGraph f (FA g s ss) = FA (f g) s ss
@@ -110,16 +111,16 @@ fixIncoming cs c@((n,()),es) = (cs'', ((n,Nothing),es'):newContexts)
alphabet :: Eq b => Graph n a (Maybe b) -> [b] alphabet :: Eq b => Graph n a (Maybe b) -> [b]
alphabet = nub . catMaybes . map getLabel . edges alphabet = nub . catMaybes . map getLabel . edges
determinize :: Eq a => NFA a -> DFA a determinize :: Ord a => NFA a -> DFA a
determinize (FA g s f) = let (ns,es) = h [start] [] [] determinize (FA g s f) = let (ns,es) = h [start] [] []
in FA (Graph (freshDFANodes g) [(n,()) | n <- ns] es) start (filter isDFAFinal ns) final = filter (not . null . (f `intersect`)) ns
where sigma = alphabet g in FA (Graph (freshDFANodes g) [(n,()) | n <- ns] es) start final
out = outgoing g where out = outgoing g
start = closure out [s] start = closure out [s]
isDFAFinal n = not (null (f `intersect` n)) isDFAFinal n = not (null (f `intersect` n))
freshDFANodes (Graph ns _ _) = map (:[]) ns freshDFANodes (Graph ns _ _) = map (:[]) ns
-- Get the new DFA states and edges produced by a set of DFA states. -- Get the new DFA states and edges produced by a set of DFA states.
new ns = unzip [ (s, (n,s,c)) | n <- ns, c <- sigma, let s = sort (reachable out c n), not (null s) ] new ns = unzip [ (s, (n,s,c)) | n <- ns, (c,s) <- reachable out n]
h currentStates oldStates oldEdges h currentStates oldStates oldEdges
| null currentStates = (oldStates,oldEdges) | null currentStates = (oldStates,oldEdges)
| otherwise = h newStates' allOldStates (newEdges++oldEdges) | otherwise = h newStates' allOldStates (newEdges++oldEdges)
@@ -132,10 +133,11 @@ closure :: Eq n => Outgoing n a (Maybe b) -> [n] -> [n]
closure out = fix closure_ closure out = fix closure_
where closure_ r = r `union` [y | x <- r, (_,y,Nothing) <- getOutgoing out x] where closure_ r = r `union` [y | x <- r, (_,y,Nothing) <- getOutgoing out x]
-- | Get all nodes reachable from a set of nodes by one edge with the given -- | Get a map which maps labels to a sort list of all nodes reachable
-- from a given set of nodes by one edge with the given
-- label and then any number of empty edges. -- label and then any number of empty edges.
reachable :: (Eq n, Eq b) => Outgoing n a (Maybe b) -> b -> [n] -> [n] reachable :: (Ord n, Ord b) => Outgoing n a (Maybe b) -> [n] -> [(b,[n])]
reachable out c ns = closure out [y | n <- ns, (_,y,Just c') <- getOutgoing out n, c' == c] reachable out ns = Map.toList $ Map.map (sort . closure out) $ Map.fromListWith union [(c,[y]) | n <- ns, (_,y,Just c) <- getOutgoing out n]
reverseNFA :: NFA a -> NFA a reverseNFA :: NFA a -> NFA a
reverseNFA (FA g s fs) = FA g''' s' [s] reverseNFA (FA g s fs) = FA g''' s' [s]