GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-22 11:19:32 -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 914430a5a8
commit e70ebfda5f
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) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/09/22 16:56:05 $ -- > CVS $Date: 2005/09/22 17:08:48 $
-- > CVS $Author: bringert $ -- > CVS $Author: bringert $
-- > CVS $Revision: 1.12 $ -- > CVS $Revision: 1.13 $
-- --
-- A simple finite state network module. -- 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 -- to one where the labels are on the nodes instead. This can add
-- up to one extra node per edge. -- up to one extra node per edge.
moveLabelsToNodes :: (Ord n,Eq a) => FA n () (Maybe a) -> FA n (Maybe a) () moveLabelsToNodes :: (Ord n,Eq a) => FA n () (Maybe a) -> FA n (Maybe a) ()
moveLabelsToNodes = onGraph moveLabelsToNodes_ moveLabelsToNodes = removeTrivialEmptyNodes . onGraph f
where moveLabelsToNodes_ gr@(Graph c _ _) = Graph c' ns (concat ess) where f gr@(Graph c _ _) = Graph c' ns (concat ess)
where is = incoming gr where is = incoming gr
(c',is') = mapAccumL fixIncoming c is (c',is') = mapAccumL fixIncoming c is
(ns,ess) = unzip (concat 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 :: (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) fixIncoming cs c@((n,()),es) = (cs'', ((n,Nothing),es'):newContexts)
where ls = nub $ map getLabel es where ls = nub $ map getLabel es