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