expand advice on importing these modules
[packages/old-time.git] / Data / Graph.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Data.Graph
4 -- Copyright : (c) The University of Glasgow 2002
5 -- License : BSD-style (see the file libraries/base/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable (uses Control.Monad.ST)
10 --
11 -- A version of the graph algorithms described in:
12 --
13 -- /Lazy Depth-First Search and Linear Graph Algorithms in Haskell/,
14 -- by David King and John Launchbury.
15 --
16 -----------------------------------------------------------------------------
17
18 module Data.Graph(
19
20 -- * External interface
21
22 -- At present the only one with a "nice" external interface
23 stronglyConnComp, stronglyConnCompR, SCC(..), flattenSCC, flattenSCCs,
24
25 -- * Graphs
26
27 Graph, Table, Bounds, Edge, Vertex,
28
29 -- ** Building graphs
30
31 graphFromEdges, graphFromEdges', buildG, transposeG,
32 -- reverseE,
33
34 -- ** Graph properties
35
36 vertices, edges,
37 outdegree, indegree,
38
39 -- * Algorithms
40
41 dfs, dff,
42 topSort,
43 components,
44 scc,
45 bcc,
46 -- tree, back, cross, forward,
47 reachable, path,
48
49 module Data.Tree
50
51 ) where
52
53 -- Extensions
54 import Control.Monad.ST
55 import Data.Array.ST (STArray, newArray, readArray, writeArray)
56 import Data.Tree (Tree(Node), Forest)
57
58 -- std interfaces
59 import Data.Maybe
60 import Data.Array
61 import Data.List
62
63 #ifdef __HADDOCK__
64 import Prelude
65 #endif
66
67 -------------------------------------------------------------------------
68 -- -
69 -- External interface
70 -- -
71 -------------------------------------------------------------------------
72
73 -- | Strongly connected component.
74 data SCC vertex = AcyclicSCC vertex -- ^ A single vertex that is not
75 -- in any cycle.
76 | CyclicSCC [vertex] -- ^ A maximal set of mutually
77 -- reachable vertices.
78
79 -- | The vertices of a list of strongly connected components.
80 flattenSCCs :: [SCC a] -> [a]
81 flattenSCCs = concatMap flattenSCC
82
83 -- | The vertices of a strongly connected component.
84 flattenSCC :: SCC vertex -> [vertex]
85 flattenSCC (AcyclicSCC v) = [v]
86 flattenSCC (CyclicSCC vs) = vs
87
88 -- | The strongly connected components of a directed graph, topologically
89 -- sorted.
90 stronglyConnComp
91 :: Ord key
92 => [(node, key, [key])]
93 -- ^ The graph: a list of nodes uniquely identified by keys,
94 -- with a list of keys of nodes this node has edges to.
95 -- The out-list may contain keys that don't correspond to
96 -- nodes of the graph; such edges are ignored.
97 -> [SCC node]
98
99 stronglyConnComp edges0
100 = map get_node (stronglyConnCompR edges0)
101 where
102 get_node (AcyclicSCC (n, _, _)) = AcyclicSCC n
103 get_node (CyclicSCC triples) = CyclicSCC [n | (n,_,_) <- triples]
104
105 -- | The strongly connected components of a directed graph, topologically
106 -- sorted. The function is the same as 'stronglyConnComp', except that
107 -- all the information about each node retained.
108 -- This interface is used when you expect to apply 'SCC' to
109 -- (some of) the result of 'SCC', so you don't want to lose the
110 -- dependency information.
111 stronglyConnCompR
112 :: Ord key
113 => [(node, key, [key])]
114 -- ^ The graph: a list of nodes uniquely identified by keys,
115 -- with a list of keys of nodes this node has edges to.
116 -- The out-list may contain keys that don't correspond to
117 -- nodes of the graph; such edges are ignored.
118 -> [SCC (node, key, [key])] -- ^ Topologically sorted
119
120 stronglyConnCompR [] = [] -- added to avoid creating empty array in graphFromEdges -- SOF
121 stronglyConnCompR edges0
122 = map decode forest
123 where
124 (graph, vertex_fn,_) = graphFromEdges edges0
125 forest = scc graph
126 decode (Node v []) | mentions_itself v = CyclicSCC [vertex_fn v]
127 | otherwise = AcyclicSCC (vertex_fn v)
128 decode other = CyclicSCC (dec other [])
129 where
130 dec (Node v ts) vs = vertex_fn v : foldr dec vs ts
131 mentions_itself v = v `elem` (graph ! v)
132
133 -------------------------------------------------------------------------
134 -- -
135 -- Graphs
136 -- -
137 -------------------------------------------------------------------------
138
139 -- | Abstract representation of vertices.
140 type Vertex = Int
141 -- | Table indexed by a contiguous set of vertices.
142 type Table a = Array Vertex a
143 -- | Adjacency list representation of a graph, mapping each vertex to its
144 -- list of successors.
145 type Graph = Table [Vertex]
146 -- | The bounds of a 'Table'.
147 type Bounds = (Vertex, Vertex)
148 -- | An edge from the first vertex to the second.
149 type Edge = (Vertex, Vertex)
150
151 -- | All vertices of a graph.
152 vertices :: Graph -> [Vertex]
153 vertices = indices
154
155 -- | All edges of a graph.
156 edges :: Graph -> [Edge]
157 edges g = [ (v, w) | v <- vertices g, w <- g!v ]
158
159 mapT :: (Vertex -> a -> b) -> Table a -> Table b
160 mapT f t = array (bounds t) [ (,) v (f v (t!v)) | v <- indices t ]
161
162 -- | Build a graph from a list of edges.
163 buildG :: Bounds -> [Edge] -> Graph
164 buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 edges0
165
166 -- | The graph obtained by reversing all edges.
167 transposeG :: Graph -> Graph
168 transposeG g = buildG (bounds g) (reverseE g)
169
170 reverseE :: Graph -> [Edge]
171 reverseE g = [ (w, v) | (v, w) <- edges g ]
172
173 -- | A table of the count of edges from each node.
174 outdegree :: Graph -> Table Int
175 outdegree = mapT numEdges
176 where numEdges _ ws = length ws
177
178 -- | A table of the count of edges into each node.
179 indegree :: Graph -> Table Int
180 indegree = outdegree . transposeG
181
182 -- | Identical to 'graphFromEdges', except that the return value
183 -- does not include the function which maps keys to vertices. This
184 -- version of 'graphFromEdges' is for backwards compatibility.
185 graphFromEdges'
186 :: Ord key
187 => [(node, key, [key])]
188 -> (Graph, Vertex -> (node, key, [key]))
189 graphFromEdges' x = (a,b) where
190 (a,b,_) = graphFromEdges x
191
192 -- | Build a graph from a list of nodes uniquely identified by keys,
193 -- with a list of keys of nodes this node should have edges to.
194 -- The out-list may contain keys that don't correspond to
195 -- nodes of the graph; they are ignored.
196 graphFromEdges
197 :: Ord key
198 => [(node, key, [key])]
199 -> (Graph, Vertex -> (node, key, [key]), key -> Maybe Vertex)
200 graphFromEdges edges0
201 = (graph, \v -> vertex_map ! v, key_vertex)
202 where
203 max_v = length edges0 - 1
204 bounds0 = (0,max_v) :: (Vertex, Vertex)
205 sorted_edges = sortBy lt edges0
206 edges1 = zipWith (,) [0..] sorted_edges
207
208 graph = array bounds0 [(,) v (mapMaybe key_vertex ks) | (,) v (_, _, ks) <- edges1]
209 key_map = array bounds0 [(,) v k | (,) v (_, k, _ ) <- edges1]
210 vertex_map = array bounds0 edges1
211
212 (_,k1,_) `lt` (_,k2,_) = k1 `compare` k2
213
214 -- key_vertex :: key -> Maybe Vertex
215 -- returns Nothing for non-interesting vertices
216 key_vertex k = findVertex 0 max_v
217 where
218 findVertex a b | a > b
219 = Nothing
220 findVertex a b = case compare k (key_map ! mid) of
221 LT -> findVertex a (mid-1)
222 EQ -> Just mid
223 GT -> findVertex (mid+1) b
224 where
225 mid = (a + b) `div` 2
226
227 -------------------------------------------------------------------------
228 -- -
229 -- Depth first search
230 -- -
231 -------------------------------------------------------------------------
232
233 type Set s = STArray s Vertex Bool
234
235 mkEmpty :: Bounds -> ST s (Set s)
236 mkEmpty bnds = newArray bnds False
237
238 contains :: Set s -> Vertex -> ST s Bool
239 contains m v = readArray m v
240
241 include :: Set s -> Vertex -> ST s ()
242 include m v = writeArray m v True
243
244 -- | A spanning forest of the graph, obtained from a depth-first search of
245 -- the graph starting from each vertex in an unspecified order.
246 dff :: Graph -> Forest Vertex
247 dff g = dfs g (vertices g)
248
249 -- | A spanning forest of the part of the graph reachable from the listed
250 -- vertices, obtained from a depth-first search of the graph starting at
251 -- each of the listed vertices in order.
252 dfs :: Graph -> [Vertex] -> Forest Vertex
253 dfs g vs = prune (bounds g) (map (generate g) vs)
254
255 generate :: Graph -> Vertex -> Tree Vertex
256 generate g v = Node v (map (generate g) (g!v))
257
258 prune :: Bounds -> Forest Vertex -> Forest Vertex
259 prune bnds ts = runST (mkEmpty bnds >>= \m ->
260 chop m ts)
261
262 chop :: Set s -> Forest Vertex -> ST s (Forest Vertex)
263 chop _ [] = return []
264 chop m (Node v ts : us)
265 = contains m v >>= \visited ->
266 if visited then
267 chop m us
268 else
269 include m v >>= \_ ->
270 chop m ts >>= \as ->
271 chop m us >>= \bs ->
272 return (Node v as : bs)
273
274 -------------------------------------------------------------------------
275 -- -
276 -- Algorithms
277 -- -
278 -------------------------------------------------------------------------
279
280 ------------------------------------------------------------
281 -- Algorithm 1: depth first search numbering
282 ------------------------------------------------------------
283
284 preorder :: Tree a -> [a]
285 preorder (Node a ts) = a : preorderF ts
286
287 preorderF :: Forest a -> [a]
288 preorderF ts = concat (map preorder ts)
289
290 tabulate :: Bounds -> [Vertex] -> Table Int
291 tabulate bnds vs = array bnds (zipWith (,) vs [1..])
292
293 preArr :: Bounds -> Forest Vertex -> Table Int
294 preArr bnds = tabulate bnds . preorderF
295
296 ------------------------------------------------------------
297 -- Algorithm 2: topological sorting
298 ------------------------------------------------------------
299
300 postorder :: Tree a -> [a]
301 postorder (Node a ts) = postorderF ts ++ [a]
302
303 postorderF :: Forest a -> [a]
304 postorderF ts = concat (map postorder ts)
305
306 postOrd :: Graph -> [Vertex]
307 postOrd = postorderF . dff
308
309 -- | A topological sort of the graph.
310 -- The order is partially specified by the condition that a vertex /i/
311 -- precedes /j/ whenever /j/ is reachable from /i/ but not vice versa.
312 topSort :: Graph -> [Vertex]
313 topSort = reverse . postOrd
314
315 ------------------------------------------------------------
316 -- Algorithm 3: connected components
317 ------------------------------------------------------------
318
319 -- | The connected components of a graph.
320 -- Two vertices are connected if there is a path between them, traversing
321 -- edges in either direction.
322 components :: Graph -> Forest Vertex
323 components = dff . undirected
324
325 undirected :: Graph -> Graph
326 undirected g = buildG (bounds g) (edges g ++ reverseE g)
327
328 -- Algorithm 4: strongly connected components
329
330 -- | The strongly connected components of a graph.
331 scc :: Graph -> Forest Vertex
332 scc g = dfs g (reverse (postOrd (transposeG g)))
333
334 ------------------------------------------------------------
335 -- Algorithm 5: Classifying edges
336 ------------------------------------------------------------
337
338 tree :: Bounds -> Forest Vertex -> Graph
339 tree bnds ts = buildG bnds (concat (map flat ts))
340 where flat (Node v ts) = [ (v, w) | Node w _us <- ts ] ++ concat (map flat ts)
341
342 back :: Graph -> Table Int -> Graph
343 back g post = mapT select g
344 where select v ws = [ w | w <- ws, post!v < post!w ]
345
346 cross :: Graph -> Table Int -> Table Int -> Graph
347 cross g pre post = mapT select g
348 where select v ws = [ w | w <- ws, post!v > post!w, pre!v > pre!w ]
349
350 forward :: Graph -> Graph -> Table Int -> Graph
351 forward g tree pre = mapT select g
352 where select v ws = [ w | w <- ws, pre!v < pre!w ] \\ tree!v
353
354 ------------------------------------------------------------
355 -- Algorithm 6: Finding reachable vertices
356 ------------------------------------------------------------
357
358 -- | A list of vertices reachable from a given vertex.
359 reachable :: Graph -> Vertex -> [Vertex]
360 reachable g v = preorderF (dfs g [v])
361
362 -- | Is the second vertex reachable from the first?
363 path :: Graph -> Vertex -> Vertex -> Bool
364 path g v w = w `elem` (reachable g v)
365
366 ------------------------------------------------------------
367 -- Algorithm 7: Biconnected components
368 ------------------------------------------------------------
369
370 -- | The biconnected components of a graph.
371 -- An undirected graph is biconnected if the deletion of any vertex
372 -- leaves it connected.
373 bcc :: Graph -> Forest [Vertex]
374 bcc g = (concat . map bicomps . map (do_label g dnum)) forest
375 where forest = dff g
376 dnum = preArr (bounds g) forest
377
378 do_label :: Graph -> Table Int -> Tree Vertex -> Tree (Vertex,Int,Int)
379 do_label g dnum (Node v ts) = Node (v,dnum!v,lv) us
380 where us = map (do_label g dnum) ts
381 lv = minimum ([dnum!v] ++ [dnum!w | w <- g!v]
382 ++ [lu | Node (u,du,lu) xs <- us])
383
384 bicomps :: Tree (Vertex,Int,Int) -> Forest [Vertex]
385 bicomps (Node (v,_,_) ts)
386 = [ Node (v:vs) us | (l,Node vs us) <- map collect ts]
387
388 collect :: Tree (Vertex,Int,Int) -> (Int, Tree [Vertex])
389 collect (Node (v,dv,lv) ts) = (lv, Node (v:vs) cs)
390 where collected = map collect ts
391 vs = concat [ ws | (lw, Node ws us) <- collected, lw<dv]
392 cs = concat [ if lw<dv then us else [Node (v:ws) us]
393 | (lw, Node ws us) <- collected ]