components.ml

(**************************************************************************)
(*                                                                        *)
(*  Ocamlgraph: a generic graph library for OCaml                         *)
(*  Copyright (C) 2004-2007                                               *)
(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)
(*                                                                        *)
(*  This software is free software; you can redistribute it and/or        *)
(*  modify it under the terms of the GNU Library General Public           *)
(*  License version 2, with the special exception on linking              *)
(*  described in file LICENSE.                                            *)
(*                                                                        *)
(*  This software is distributed in the hope that it will be useful,      *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
(*                                                                        *)
(**************************************************************************)

(* $Id: components.ml,v 1.9 2004-10-22 14:42:06 signoles Exp $ *)

open Util

module type G = sig
  type t
  module V : Sig.COMPARABLE
  val iter_vertex : (V.t -> unit) -> t -> unit
  val iter_succ : (V.t -> unit) -> t -> V.t -> unit
end

module Make(G: G) = struct

  module H = Hashtbl.Make(G.V)
  module S = Set.Make(G.V)

  let scc g =
    let root = H.create 997 in
    let hashcomp = H.create 997 in
    let stack = ref [] in
    let numdfs = ref 0 in
    let numcomp = ref 0 in
    let rec pop x c = function
      | (y, w) :: l when y > x -> 
	  H.add hashcomp w !numcomp; 
	  pop x (S.add w c) l
      | l -> c,l
    in
    let rec visit v = 
      if not (H.mem root v) then
	begin
	  let n = incr numdfs; !numdfs in
	  H.add root v n; 
	  G.iter_succ 
	    (fun w -> 
	       visit w;
	       if not (H.mem hashcomp w) then 
		 H.replace root v (min (H.find root v) (H.find root w)))
	    g v;
	  if H.find root v = n then 
	    (H.add hashcomp v !numcomp;
	     let comp,s = pop n (S.add v S.empty) !stack in 
	     stack:= s;
	     incr numcomp)
	  else stack := (n,v)::!stack;
	end
    in 
    G.iter_vertex visit g;
    (!numcomp,(fun v -> H.find hashcomp v))

  let scc_array g =
    let n,f = scc g in
    let t = Array.make n [] in
    G.iter_vertex 
      (fun v -> let i = f v in t.(i) <- v::t.(i)) g;
    t

  let scc_list g =
    let _,scc = scc g in
    let tbl = Hashtbl.create 97 in
    G.iter_vertex 
      (fun v -> 
	 let n = scc v in
	 try
	   let l = Hashtbl.find tbl n in
	   l := v :: !l
	 with Not_found ->
	   Hashtbl.add tbl n (ref [ v ]))
      g;
    Hashtbl.fold (fun _ v l -> !v :: l) tbl []


end