diff options
| author | bringert <unknown> | 2005-09-22 16:08:48 +0000 |
|---|---|---|
| committer | bringert <unknown> | 2005-09-22 16:08:48 +0000 |
| commit | a2ff05dfd95d116f585aad1047666ed99e0f88cc (patch) | |
| tree | 8bf68a05678e708303fcea7a9391a63153adf247 /src | |
| parent | 9bb01bfc3892f545162806e88daf9a0d6c28c8f7 (diff) | |
Added placeholder for minimizing SLF-style automata.
Diffstat (limited to 'src')
| -rw-r--r-- | src/GF/Speech/FiniteState.hs | 13 |
1 files changed, 9 insertions, 4 deletions
diff --git a/src/GF/Speech/FiniteState.hs b/src/GF/Speech/FiniteState.hs index 66e007fd9..e8e80e4be 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/22 16:56:05 $ +-- > CVS $Date: 2005/09/22 17:08:48 $ -- > CVS $Author: bringert $ --- > CVS $Revision: 1.12 $ +-- > CVS $Revision: 1.13 $ -- -- A simple finite state network module. ----------------------------------------------------------------------------- @@ -80,12 +80,17 @@ onGraph f (FA g s ss) = FA (f g) s ss -- to one where the labels are on the nodes instead. This can add -- up to one extra node per edge. moveLabelsToNodes :: (Ord n,Eq a) => FA n () (Maybe a) -> FA n (Maybe a) () -moveLabelsToNodes = onGraph moveLabelsToNodes_ - where moveLabelsToNodes_ gr@(Graph c _ _) = Graph c' ns (concat ess) +moveLabelsToNodes = removeTrivialEmptyNodes . onGraph f + where f gr@(Graph c _ _) = Graph c' ns (concat ess) where is = incoming gr (c',is') = mapAccumL fixIncoming c is (ns,ess) = unzip (concat is') +-- | Remove nodes which are not start or final, and have +-- exactly one incoming or exactly one outgoing edge. +removeTrivialEmptyNodes :: FA n (Maybe a) () -> FA n (Maybe a) () +removeTrivialEmptyNodes = id -- FIXME: implement + fixIncoming :: (Eq n, Eq a) => [n] -> (Node n (),[Edge n (Maybe a)]) -> ([n],[(Node n (Maybe a),[Edge n ()])]) fixIncoming cs c@((n,()),es) = (cs'', ((n,Nothing),es'):newContexts) where ls = nub $ map getLabel es |