Fixed-point iterate unneccessary node removeal.

This commit is contained in:
bringert
2006-01-05 20:55:13 +00:00
parent dc3f7e1d61
commit 3bf8e5ce6f

View File

@@ -145,16 +145,17 @@ moveLabelsToNodes = onGraph f
-- | Remove empty nodes which are not start or final, and have -- | Remove empty nodes which are not start or final, and have
-- exactly one outgoing edge or exactly one incoming edge. -- exactly one outgoing edge or exactly one incoming edge.
removeTrivialEmptyNodes :: Ord n => FA n (Maybe a) () -> FA n (Maybe a) () removeTrivialEmptyNodes :: (Eq a, Ord n) => FA n (Maybe a) () -> FA n (Maybe a) ()
removeTrivialEmptyNodes = pruneUnusable . skipSimpleEmptyNodes removeTrivialEmptyNodes = pruneUnusable . skipSimpleEmptyNodes
-- | Move edges to empty nodes with exactly one outgoing edge -- | Move edges to empty nodes with exactly one outgoing edge
-- or exactly one incoming edge to point to the next node(s). -- or exactly one incoming edge to point to the next node(s).
skipSimpleEmptyNodes :: Ord n => FA n (Maybe a) () -> FA n (Maybe a) () skipSimpleEmptyNodes :: (Eq a, Ord n) => FA n (Maybe a) () -> FA n (Maybe a) ()
skipSimpleEmptyNodes = onGraph og skipSimpleEmptyNodes = onGraph og
where where
og g@(Graph c ns es) = Graph c ns (concatMap changeEdge es) og g@(Graph c ns es) = if es' == es then g else og (Graph c ns es')
where where
es' = concatMap changeEdge es
info = nodeInfo g info = nodeInfo g
changeEdge e@(f,t,()) changeEdge e@(f,t,())
| isNothing (getNodeLabel info t) | isNothing (getNodeLabel info t)
@@ -171,11 +172,12 @@ isInternal (FA _ start final) n = n /= start && n `notElem` final
pruneUnusable :: Ord n => FA n (Maybe a) () -> FA n (Maybe a) () pruneUnusable :: Ord n => FA n (Maybe a) () -> FA n (Maybe a) ()
pruneUnusable fa = onGraph f fa pruneUnusable fa = onGraph f fa
where where
f g = removeNodes (Set.fromList [ n | (n,_) <- nodes g, f g = if Set.null rns then g else f (removeNodes rns g)
isInternal fa n,
inDegree info n == 0
|| outDegree info n == 0]) g
where info = nodeInfo g where info = nodeInfo g
rns = Set.fromList [ n | (n,_) <- nodes g,
isInternal fa n,
inDegree info n == 0
|| outDegree info n == 0]
fixIncoming :: (Ord n, Eq a) => [n] fixIncoming :: (Ord n, Eq a) => [n]
-> (Node n (),[Edge n (Maybe a)]) -- ^ A node and its incoming edges -> (Node n (),[Edge n (Maybe a)]) -- ^ A node and its incoming edges