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

Some preparations for graph minimization.

Browse Source
This commit is contained in:
bringert
2005-09-12 20:54:32 +00:00
parent fea451f06c
commit 4ed9ada62e
1 changed files with 14 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/09/12 21:41:19 $ -- > CVS $Date: 2005/09/12 21:54:32 $
-- > CVS $Author: bringert $ -- > CVS $Author: bringert $
-- > CVS $Revision: 1.4 $ -- > CVS $Revision: 1.5 $
-- --
-- A simple finite state network module. -- 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)) 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_ :: 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 where is = incoming gr
(c',is') = mapAccumL fixIncoming c is (c',is') = mapAccumL fixIncoming c is
(ns,ls,ess) = unzip3 (concat 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 isEmptyLoop _ = False
mimimizeGr2 :: Graph (Maybe a) () -> Graph (Maybe a) () 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 String String -> String
prGraphGraphviz (Graph _ ss ts) = prGraphGraphviz (Graph _ ss ts) =
@@ -158,3 +160,11 @@ prGraphGraphviz (Graph _ ss ts) =
++ "\n}\n" ++ "\n}\n"
where prNode (n,l) = show n ++ " [label = " ++ show l ++ "]" where prNode (n,l) = show n ++ " [label = " ++ show l ++ "]"
prEdge (f,t,l) = show f ++ " -> " ++ show t ++ " [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