mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-22 03:09:33 -06:00
Fixed-point iterate unneccessary node removeal.
This commit is contained in:
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user