2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[Digraph]{An implementation of directed graphs}
9 --OLD: whichCycle, -- MOVED: isCyclic,
15 import Maybes ( MaybeErr(..) )
19 This module implements at least part of an abstract data type for
20 directed graphs. The part implemented is what we need for doing
23 >type Edge vertex = (vertex, vertex)
24 >type Cycle vertex = [vertex]
26 %************************************************************************
28 %* Strongly connected components *
30 %************************************************************************
32 John Launchbury provided the basic code for doing strongly-connected
35 The result is a list of cycles (each of which is a list of vertices),
36 and these cycles are topologically sorted, so that if there is an edge from
37 cycle A to cycle B, then A occurs after B in the result list.
40 stronglyConnComp :: (vertex->vertex->Bool) -> [Edge vertex] -> [vertex] -> [[vertex]]
42 stronglyConnComp eq edges vertices
43 = snd (span_tree (new_range reversed_edges)
45 ( snd (dfs (new_range edges) ([],[]) vertices) )
48 reversed_edges = map swap edges
52 -- new_range :: Eq v => [Edge v] -> v -> [v]
55 new_range ((x,y):xys) w
57 then (y : (new_range xys w))
58 else (new_range xys w)
61 elem x (y:ys) = x `eq` y || x `elem` ys
63 {- span_tree :: Eq v => (v -> [v])
68 span_tree r (vs,ns) [] = (vs,ns)
69 span_tree r (vs,ns) (x:xs)
70 | x `elem` vs = span_tree r (vs,ns) xs
71 | True = case (dfs r (x:vs,[]) (r x)) of { (vs',ns') ->
72 span_tree r (vs',(x:ns'):ns) xs }
74 {- dfs :: Eq v => (v -> [v])
79 dfs r (vs,ns) [] = (vs,ns)
80 dfs r (vs,ns) (x:xs) | x `elem` vs = dfs r (vs,ns) xs
81 | True = case (dfs r (x:vs,[]) (r x)) of { (vs',ns') ->
82 dfs r (vs',(x:ns')++ns) xs }
86 dfs :: (v -> v -> Bool)
92 dfs eq r (vs,ns) [] = (vs,ns)
93 dfs eq r (vs,ns) (x:xs)
94 | any (eq x) vs = dfs eq r (vs,ns) xs
95 | True = case (dfs eq r (x:vs,[]) (r x)) of
96 (vs',ns') -> dfs eq r (vs',(x:ns')++ns) xs
101 @isCyclic@ expects to be applied to an element of the result of a
102 stronglyConnComp; it tells whether such an element is a cycle. The
103 answer is True if it is not a singleton, of course, but if it is a
104 singleton we have to look up in the edges to see if it refers to
108 {- MOVED TO POINT OF SINGLE USE: RenameBinds4 (WDP 95/02)
110 isCyclic :: Eq vertex => [Edge vertex] -> [vertex] -> Bool
112 isCyclic edges [] = panic "isCyclic: empty component"
113 isCyclic edges [v] = (v,v) `is_elem` edges where { is_elem = isIn "isCyclic" }
114 isCyclic edges vs = True
118 OLD: The following @whichCycle@ should be called only when the given
119 @vertex@ is known to be in one of the cycles. This isn't difficult to
120 achieve if the call follows the creation of the list of components by
121 @cycles@ (NB: strictness analyser) with all vertices of interest in
125 >whichCycle :: Eq vertex => [Cycle vertex] -> vertex -> (Cycle vertex)
126 >whichCycle vss v = head [vs | vs <-vss, v `is_elem` vs] where { is_elem = isIn "whichCycle" }
129 %************************************************************************
131 %* Topological sort *
133 %************************************************************************
135 Topological sort fails if it finds any cycles, returning the offending cycles.
137 If it succeeds, the result is a list of vertices, such that if there is
138 an edge from vertex A to vertex B then A occurs after B in the result list.
141 topologicalSort :: (vertex->vertex->Bool) -> [Edge vertex] -> [vertex]
142 -> MaybeErr [vertex] -- Success: the sorted list
143 [[vertex]] -- Failure: the cycles
145 topologicalSort eq edges vertices
146 = case (stronglyConnComp eq edges vertices) of { sccs ->
147 case (partition (is_cyclic edges) sccs) of { (cycles, singletons) ->
149 then Succeeded [ v | [v] <- singletons ]
153 is_cyclic es [] = panic "is_cyclic: empty component"
154 is_cyclic es [v] = (v,v) `elem` es
155 is_cyclic es vs = True
157 elem (x,y) [] = False
158 elem z@(x,y) ((a,b):cs) = (x `eq` a && y `eq` b) || z `elem` cs