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 ]