GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

Added placeholder for minimizing SLF-style automata.

Browse Source
This commit is contained in:
bringert
2005-09-22 16:08:48 +00:00
parent 9bb01bfc38
commit a2ff05dfd9
1 changed files with 9 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -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