From 9dfa8a5032034a26f2f40c72ecf0744bf959c605 Mon Sep 17 00:00:00 2001
From: bringert <unknown>
Date: Thu, 27 Oct 2005 08:16:30 +0000
Subject: [PATCH] Reduced complexity of reachable in FA determinization.

---
 src/GF/Speech/FiniteState.hs | 26 ++++++++++++++------------
 1 file changed, 14 insertions(+), 12 deletions(-)

diff --git a/src/GF/Speech/FiniteState.hs b/src/GF/Speech/FiniteState.hs
index 42aa99e8b..51cacb1e1 100644
--- a/src/GF/Speech/FiniteState.hs
+++ b/src/GF/Speech/FiniteState.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/10/26 17:13:13 $ 
+-- > CVS $Date: 2005/10/27 09:16:30 $ 
 -- > CVS $Author: bringert $
--- > CVS $Revision: 1.14 $
+-- > CVS $Revision: 1.15 $
 --
 -- A simple finite state network module.
 -----------------------------------------------------------------------------
@@ -23,6 +23,8 @@ module GF.Speech.FiniteState (FA, State, NFA, DFA,
 
 import Data.List
 import Data.Maybe (catMaybes,fromJust)
+import Data.Map (Map)
+import qualified Data.Map as Map
 
 import GF.Data.Utilities
 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 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
 
-
 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
 
@@ -110,16 +111,16 @@ fixIncoming cs c@((n,()),es) = (cs'', ((n,Nothing),es'):newContexts)
 alphabet :: Eq b => Graph n a (Maybe b) -> [b]
 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] [] []
-			     in FA (Graph (freshDFANodes g) [(n,()) | n <- ns] es) start (filter isDFAFinal ns)
-  where sigma = alphabet g
-	out = outgoing g
+                             final = filter (not . null . (f `intersect`)) ns
+ 		          in FA (Graph (freshDFANodes g) [(n,()) | n <- ns] es) start final
+  where out = outgoing g
 	start = closure out [s]
 	isDFAFinal n = not (null (f `intersect` n))
 	freshDFANodes (Graph ns _ _) = map (:[]) ns
 	-- 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 
 	    | null currentStates = (oldStates,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_
     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.
-reachable :: (Eq n, Eq b) => Outgoing n a (Maybe b) -> b -> [n] -> [n]
-reachable out c ns = closure out [y | n <- ns, (_,y,Just c') <- getOutgoing out n, c' == c]
+reachable :: (Ord n, Ord b) => Outgoing n a (Maybe b) -> [n] -> [(b,[n])]
+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 (FA g s fs) = FA g''' s' [s]