diff options
| author | bringert <unknown> | 2005-09-12 20:54:32 +0000 |
|---|---|---|
| committer | bringert <unknown> | 2005-09-12 20:54:32 +0000 |
| commit | 8e53a8e849053622b9729d2d7fdebaa5e509d48d (patch) | |
| tree | 901a764a2601ba2f824eee49f998e236a999fe22 | |
| parent | 37ef225420a337c4a2f9a2f9002aea42b8a24518 (diff) | |
Some preparations for graph minimization.
| -rw-r--r-- | src/GF/Speech/FiniteState.hs | 18 |
1 files changed, 14 insertions, 4 deletions
diff --git a/src/GF/Speech/FiniteState.hs b/src/GF/Speech/FiniteState.hs index e3e1245ce..f758975dc 100644 --- a/src/GF/Speech/FiniteState.hs +++ b/src/GF/Speech/FiniteState.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/09/12 21:41:19 $ +-- > CVS $Date: 2005/09/12 21:54:32 $ -- > CVS $Author: bringert $ --- > CVS $Revision: 1.4 $ +-- > CVS $Revision: 1.5 $ -- -- A simple finite state network module. ----------------------------------------------------------------------------- @@ -115,7 +115,7 @@ incoming (Graph _ ns es) = snd $ mapAccumL f (sortBy compareDest es) (sortBy com f es' (n,l) = let (nes,es'') = span (destIs n) es' in (es'',(n,l,nes)) moveLabelsToNodes_ :: Eq a => Graph () (Maybe a) -> Graph (Maybe a) () -moveLabelsToNodes_ gr@(Graph c _ _) = Graph c' (zip ns ls) (concat ess) +moveLabelsToNodes_ gr@(Graph c _ _) = mimimizeGr2 $ Graph c' (zip ns ls) (concat ess) where is = incoming gr (c',is') = mapAccumL fixIncoming c is (ns,ls,ess) = unzip3 (concat is') @@ -147,8 +147,10 @@ removeEmptyLoops1 (Graph c ns es) = Graph c ns (filter (not . isEmptyLoop) es) isEmptyLoop _ = False mimimizeGr2 :: Graph (Maybe a) () -> Graph (Maybe a) () -mimimizeGr2 gr = gr +mimimizeGr2 = id +removeDuplicateEdges :: Ord b => Graph a b -> Graph a b +removeDuplicateEdges (Graph c ns es) = Graph c ns (sortNub es) prGraphGraphviz :: Graph String String -> String prGraphGraphviz (Graph _ ss ts) = @@ -158,3 +160,11 @@ prGraphGraphviz (Graph _ ss ts) = ++ "\n}\n" where prNode (n,l) = show n ++ " [label = " ++ show l ++ "]" prEdge (f,t,l) = show f ++ " -> " ++ show t ++ " [label = " ++ show l ++ "]" + + +-- +-- * Utilities +-- + +sortNub :: Ord a => [a] -> [a] +sortNub = map head . group . sort
\ No newline at end of file |