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         -- 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 -- | Build a graph from a list of nodes uniquely identified by keys,
 183 -- with a list of keys of nodes this node should have edges to.
 184 -- The out-list may contain keys that don't correspond to
 185 -- nodes of the graph; they are ignored.
 186 graphFromEdges
 187         :: Ord key
 188         => [(node, key, [key])]
 189         -> (Graph, Vertex -> (node, key, [key]))
 190 graphFromEdges edges0
 191   = (graph, \v -> vertex_map ! v)
 192   where
 193     max_v           = length edges0 - 1
 194     bounds0         = (0,max_v) :: (Vertex, Vertex)
 195     sorted_edges    = sortBy lt edges0
 196     edges1          = zipWith (,) [0..] sorted_edges
 197
 198     graph           = array bounds0 [(,) v (mapMaybe key_vertex ks) | (,) v (_,    _, ks) <- edges1]
 199     key_map         = array bounds0 [(,) v k                       | (,) v (_,    k, _ ) <- edges1]
 200     vertex_map      = array bounds0 edges1
 201
 202     (_,k1,_) `lt` (_,k2,_) = k1 `compare` k2
 203
 204     -- key_vertex :: key -> Maybe Vertex
 205     --  returns Nothing for non-interesting vertices
 206     key_vertex k   = findVertex 0 max_v
 207                    where
 208                      findVertex a b | a > b
 209                               = Nothing
 210                      findVertex a b = case compare k (key_map ! mid) of
 211                                    LT -> findVertex a (mid-1)
 212                                    EQ -> Just mid
 213                                    GT -> findVertex (mid+1) b
 214                               where
 215                                 mid = (a + b) `div` 2
 216
 217 -------------------------------------------------------------------------
 218 --                                                                      -
 219 --      Depth first search
 220 --                                                                      -
 221 -------------------------------------------------------------------------
 222
 223 type Set s    = STArray s Vertex Bool
 224
 225 mkEmpty      :: Bounds -> ST s (Set s)
 226 mkEmpty bnds  = newArray bnds False
 227
 228 contains     :: Set s -> Vertex -> ST s Bool
 229 contains m v  = readArray m v
 230
 231 include      :: Set s -> Vertex -> ST s ()
 232 include m v   = writeArray m v True
 233
 234 -- | A spanning forest of the graph, obtained from a depth-first search of
 235 -- the graph starting from each vertex in an unspecified order.
 236 dff          :: Graph -> Forest Vertex
 237 dff g         = dfs g (vertices g)
 238
 239 -- | A spanning forest of the part of the graph reachable from the listed
 240 -- vertices, obtained from a depth-first search of the graph starting at
 241 -- each of the listed vertices in order.
 242 dfs          :: Graph -> [Vertex] -> Forest Vertex
 243 dfs g vs      = prune (bounds g) (map (generate g) vs)
 244
 245 generate     :: Graph -> Vertex -> Tree Vertex
 246 generate g v  = Node v (map (generate g) (g!v))
 247
 248 prune        :: Bounds -> Forest Vertex -> Forest Vertex
 249 prune bnds ts = runST (mkEmpty bnds  >>= \m ->
 250                        chop m ts)
 251
 252 chop         :: Set s -> Forest Vertex -> ST s (Forest Vertex)
 253 chop _ []     = return []
 254 chop m (Node v ts : us)
 255               = contains m v >>= \visited ->
 256                 if visited then
 257                   chop m us
 258                 else
 259                   include m v >>= \_  ->
 260                   chop m ts   >>= \as ->
 261                   chop m us   >>= \bs ->
 262                   return (Node v as : bs)
 263
 264 -------------------------------------------------------------------------
 265 --                                                                      -
 266 --      Algorithms
 267 --                                                                      -
 268 -------------------------------------------------------------------------
 269
 270 ------------------------------------------------------------
 271 -- Algorithm 1: depth first search numbering
 272 ------------------------------------------------------------
 273
 274 preorder            :: Tree a -> [a]
 275 preorder (Node a ts) = a : preorderF ts
 276
 277 preorderF           :: Forest a -> [a]
 278 preorderF ts         = concat (map preorder ts)
 279
 280 tabulate        :: Bounds -> [Vertex] -> Table Int
 281 tabulate bnds vs = array bnds (zipWith (,) vs [1..])
 282
 283 preArr          :: Bounds -> Forest Vertex -> Table Int
 284 preArr bnds      = tabulate bnds . preorderF
 285
 286 ------------------------------------------------------------
 287 -- Algorithm 2: topological sorting
 288 ------------------------------------------------------------
 289
 290 postorder :: Tree a -> [a]
 291 postorder (Node a ts) = postorderF ts ++ [a]
 292
 293 postorderF   :: Forest a -> [a]
 294 postorderF ts = concat (map postorder ts)
 295
 296 postOrd      :: Graph -> [Vertex]
 297 postOrd       = postorderF . dff
 298
 299 -- | A topological sort of the graph.
 300 -- The order is partially specified by the condition that a vertex /i/
 301 -- precedes /j/ whenever /j/ is reachable from /i/ but not vice versa.
 302 topSort      :: Graph -> [Vertex]
 303 topSort       = reverse . postOrd
 304
 305 ------------------------------------------------------------
 306 -- Algorithm 3: connected components
 307 ------------------------------------------------------------
 308
 309 -- | The connected components of a graph.
 310 -- Two vertices are connected if there is a path between them, traversing
 311 -- edges in either direction.
 312 components   :: Graph -> Forest Vertex
 313 components    = dff . undirected
 314
 315 undirected   :: Graph -> Graph
 316 undirected g  = buildG (bounds g) (edges g ++ reverseE g)
 317
 318 -- Algorithm 4: strongly connected components
 319
 320 -- | The strongly connected components of a graph.
 321 scc  :: Graph -> Forest Vertex
 322 scc g = dfs g (reverse (postOrd (transposeG g)))
 323
 324 ------------------------------------------------------------
 325 -- Algorithm 5: Classifying edges
 326 ------------------------------------------------------------
 327
 328 tree              :: Bounds -> Forest Vertex -> Graph
 329 tree bnds ts       = buildG bnds (concat (map flat ts))
 330  where flat (Node v ts) = [ (v, w) | Node w _us <- ts ] ++ concat (map flat ts)
 331
 332 back              :: Graph -> Table Int -> Graph
 333 back g post        = mapT select g
 334  where select v ws = [ w | w <- ws, post!v < post!w ]
 335
 336 cross             :: Graph -> Table Int -> Table Int -> Graph
 337 cross g pre post   = mapT select g
 338  where select v ws = [ w | w <- ws, post!v > post!w, pre!v > pre!w ]
 339
 340 forward           :: Graph -> Graph -> Table Int -> Graph
 341 forward g tree pre = mapT select g
 342  where select v ws = [ w | w <- ws, pre!v < pre!w ] \\ tree!v
 343
 344 ------------------------------------------------------------
 345 -- Algorithm 6: Finding reachable vertices
 346 ------------------------------------------------------------
 347
 348 -- | A list of vertices reachable from a given vertex.
 349 reachable    :: Graph -> Vertex -> [Vertex]
 350 reachable g v = preorderF (dfs g [v])
 351
 352 -- | Is the second vertex reachable from the first?
 353 path         :: Graph -> Vertex -> Vertex -> Bool
 354 path g v w    = w `elem` (reachable g v)
 355
 356 ------------------------------------------------------------
 357 -- Algorithm 7: Biconnected components
 358 ------------------------------------------------------------
 359
 360 -- | The biconnected components of a graph.
 361 -- An undirected graph is biconnected if the deletion of any vertex
 362 -- leaves it connected.
 363 bcc :: Graph -> Forest [Vertex]
 364 bcc g = (concat . map bicomps . map (do_label g dnum)) forest
 365  where forest = dff g
 366        dnum   = preArr (bounds g) forest
 367
 368 do_label :: Graph -> Table Int -> Tree Vertex -> Tree (Vertex,Int,Int)
 369 do_label g dnum (Node v ts) = Node (v,dnum!v,lv) us
 370  where us = map (do_label g dnum) ts
 371        lv = minimum ([dnum!v] ++ [dnum!w | w <- g!v]
 372                      ++ [lu | Node (u,du,lu) xs <- us])
 373
 374 bicomps :: Tree (Vertex,Int,Int) -> Forest [Vertex]
 375 bicomps (Node (v,_,_) ts)
 376       = [ Node (v:vs) us | (l,Node vs us) <- map collect ts]
 377
 378 collect :: Tree (Vertex,Int,Int) -> (Int, Tree [Vertex])
 379 collect (Node (v,dv,lv) ts) = (lv, Node (v:vs) cs)
 380  where collected = map collect ts
 381        vs = concat [ ws | (lw, Node ws us) <- collected, lw<dv]
 382        cs = concat [ if lw<dv then us else [Node (v:ws) us]
 383                         | (lw, Node ws us) <- collected ]