From fa78ca1a30435b1a3c56074576a112dfc39bca7e Mon Sep 17 00:00:00 2001
From: josch <j.schauer@email.de>
Date: Wed, 4 Jul 2012 09:55:47 +0200
Subject: [PATCH] iterative and functional cycle code outputs correct results

---
 cycles_functional.ml |  96 ++++++++++++++++++----------------------
 cycles_iter.ml       | 102 +++++++++++++++++++++----------------------
 2 files changed, 92 insertions(+), 106 deletions(-)

diff --git a/cycles_functional.ml b/cycles_functional.ml
index 0d99af1..54789b1 100644
--- a/cycles_functional.ml
+++ b/cycles_functional.ml
@@ -9,7 +9,7 @@ module SV = Set.Make(G.V)
 
 let to_set l = List.fold_right SV.add l SV.empty ;;
 
-let partition s w = snd(SV.partition (fun e -> e >= w) s);;
+let partition s w = fst(SV.partition (fun e -> e >= w) s);;
 
 let print_set s = 
   String.join " " (List.map (fun e ->
@@ -51,17 +51,11 @@ let init_block g =
   t
 ;;
 
-let get_notelem t n =
-  Hashtbl.find t.notelem n
-;;
-
 let rec unblock t n =
-  Printf.eprintf "unblock %d\n" (G.V.label n);
   if Hashtbl.find t.blocked n then begin
     Hashtbl.replace t.blocked n false;
-    let l = get_notelem t n in
-    List.iter (unblock t) l;
-    Hashtbl.replace t.notelem n []
+    List.iter (unblock t) (Hashtbl.find t.notelem n);
+    Hashtbl.replace t.notelem n [];
   end
 ;;
 
@@ -69,10 +63,6 @@ let block t n =
   Hashtbl.replace t.blocked n true
 ;;
 
-let is_bloked t n =
-  Hashtbl.find t.blocked n
-;;
-
 let find_all_cycles_johnson g =
   if not G.is_directed then
     assert false;
@@ -85,76 +75,76 @@ let find_all_cycles_johnson g =
     Stack.push thisnode path;
     block t thisnode;
 
-    let (closed,result) = 
+    let (closed,result) =
       G.fold_succ (fun nextnode (c,r) ->
-        Printf.eprintf "startnode %d\n" (G.V.label startnode);
-        Printf.eprintf "nextnode %d\n" (G.V.label nextnode);
         if G.V.equal nextnode startnode then begin
-          Printf.eprintf "closed = true 1\n";
-          (true,(Stack.copy path)::r)
-        end else begin 
-          if not(is_bloked t nextnode) then
-            circuit t r nextnode startnode component 
-          else
+          (true, (stack_to_list path)::r)
+        end else begin
+          if not(Hashtbl.find t.blocked nextnode) then begin
+            let c2, r2 = circuit t r nextnode startnode component in
+            (c || c2, r2)
+          end else
             (c,r)
-        end 
+        end
       ) component thisnode (false,result)
     in
     if closed then begin
-      Printf.eprintf "closed = true 3\n";
       unblock t thisnode
     end else
       G.iter_succ (fun nextnode ->
-        let l = get_notelem t nextnode in
-        if List.mem thisnode l then
+        let l = Hashtbl.find t.notelem nextnode in
+        if not(List.mem thisnode l) then
           Hashtbl.replace t.notelem nextnode (thisnode::l)
       ) component thisnode;
-
     ignore(Stack.pop path);
-    (closed,result)
+    (closed, result)
   in
 
  (* Johnson's algorithm requires some ordering of the nodes. *)
   let vertex_set = G.fold_vertex SV.add g SV.empty in
-  Printf.eprintf "inital vertex set %s\n" (print_set vertex_set);
-  SV.fold (fun s result ->
+  let result = SV.fold (fun s result ->
     (* Build the subgraph induced by s and following nodes in the ordering *)
-    Printf.eprintf "selected element %d\n" (G.V.label s);
     let subset = SV.add s (partition vertex_set s) in
-    Printf.eprintf "subset %s\n" (print_set subset);
     let subgraph = extract_subgraph g subset in
 
-    if G.nb_edges subgraph > 0 then begin
-      (* Find the strongly connected component in the subgraph
-       * that contains the least node according to the ordering *)
-      let scc = G.Components.scc_list subgraph in
-      let minnode = SV.min_elt subset in
-      Printf.eprintf "minnode %d\n" (G.V.label minnode);
-      let mincomp = List.find (fun l -> List.mem minnode l) scc in
-      Printf.eprintf "mincomp %s\n" (print_set ((to_set mincomp)));
-
-      (* smallest node in the component according to the ordering *)
-      let startnode = minnode in
-      let component = extract_subgraph subgraph (to_set mincomp) in
+    (* Find the strongly connected component in the subgraph
+     * that contains the least node according to the ordering *)
+    let scc = G.Components.scc_list subgraph in
+    let minnode = SV.min_elt subset in
+    let mincomp = List.find (fun l -> List.mem minnode l) scc in
 
-      G.dot_output component (Printf.sprintf "test-component%d.dot" (G.V.label s));
+    (* smallest node in the component according to the ordering *)
+    let component = extract_subgraph subgraph (to_set mincomp) in
 
+    if G.nb_edges component > 0 then begin
       (* init the block table for this component *)
       let t = init_block component in
 
-      snd(circuit t result startnode startnode component);
-    end else begin
-      Printf.eprintf "No edges to consider\n";
+      snd(circuit t result minnode minnode component);
+    end else
       result
-    end
   ) vertex_set []
+  in
+  List.rev result
 ;;
 
-let g = G.Rand.graph ~v:5 ~e:10 () in
-G.dot_output g "test.dot";
+if Array.length Sys.argv < 3 then begin
+  Printf.printf "usage: %s num_vertices [v1,v2...]\n" Sys.argv.(0);
+  exit 1;
+end;
+
+let v = int_of_string (Sys.argv.(1)) in
+let g = G.create ~size:v () in
+
+let a = Array.init v G.V.create in
+
+for i = 2 to Array.length Sys.argv - 1 do
+  let v1, v2 = String.split Sys.argv.(i) "," in
+  G.add_edge g a.(int_of_string v1) a.(int_of_string v2);
+done;
+
 let ll = find_all_cycles_johnson g in
 List.iter (fun path ->
-  let path = stack_to_list path in
-  Printf.printf "path : %s\n" 
+  Printf.printf "%s\n" 
   (String.join " " (List.map (fun e -> string_of_int (G.V.label e)) path))
 ) ll
diff --git a/cycles_iter.ml b/cycles_iter.ml
index 3f353ad..c23a4fc 100644
--- a/cycles_iter.ml
+++ b/cycles_iter.ml
@@ -17,52 +17,48 @@ let find_all_cycles_johnson g =
     (* list to accumulate the circuits found  *)
   let result = ref [] in
 
-  let rec circuit thisnode startnode component = 
-    let stack_to_list s = 
-      let l = ref [] in
-      Stack.iter (fun e -> l:= e::!l) s;
-      !l
-    in
+  let rec unblock n =
+    if Hashtbl.find blocked n then begin
+      Hashtbl.replace blocked n false;
+      List.iter unblock (Hashtbl.find b n);
+      Hashtbl.replace b n [];
+    end
+  in
 
-    let rec unblock thisnode =
-      Printf.eprintf "unblock %d\n" (G.V.label thisnode);
-      if Hashtbl.find blocked thisnode then begin
-        Hashtbl.replace blocked thisnode false;
-        List.iter unblock (Hashtbl.find b thisnode);
-        Hashtbl.replace b thisnode []
-      end
-    in
+  let stack_to_list s = 
+    let l = ref [] in
+    Stack.iter (fun e -> l:= e::!l) s;
+    !l
+  in
+
+  let rec circuit thisnode startnode component = 
     let closed = ref false in
     Stack.push thisnode path;
     Hashtbl.replace blocked thisnode true;
     G.iter_succ (fun nextnode ->
-      Printf.eprintf "startnode %d\n" (G.V.label startnode);
-      Printf.eprintf "nextnode %d\n" (G.V.label nextnode);
       if G.V.equal nextnode startnode then begin
         result := ((stack_to_list path))::!result;
         closed := true;
-        Printf.eprintf "closed = true 1\n";
       end else begin if not(Hashtbl.find blocked nextnode) then
         if circuit nextnode startnode component then begin
           closed := true;
-          Printf.eprintf "closed = true 2\n";
         end
       end
     ) component thisnode;
     if !closed then begin
-      Printf.eprintf "closed = true 3\n";
       unblock thisnode
     end
     else
       G.iter_succ (fun nextnode ->
-        if List.mem thisnode (Hashtbl.find b nextnode) then
-          Hashtbl.replace b nextnode (thisnode::(Hashtbl.find b nextnode))
+        let l = Hashtbl.find b nextnode in
+        if not(List.mem thisnode l) then
+          Hashtbl.replace b nextnode (thisnode::l)
       ) component thisnode;
     ignore(Stack.pop path);
     !closed
   in
   let module SV = Set.Make(G.V) in
-  let subgraph_ g s =
+  let extract_subgraph g s =
     let sg = G.create () in
     G.iter_edges (fun v1 v2 ->
       if SV.mem v1 s then G.add_vertex sg v1;
@@ -77,47 +73,47 @@ let find_all_cycles_johnson g =
   *)
   let to_set l = List.fold_right SV.add l SV.empty in
   let vertex_set = G.fold_vertex SV.add g SV.empty in
-  let part s w = snd(SV.partition (fun e -> e >= w) s) in
-  let print_set s = 
-    String.join " " (List.map (fun e ->
-      string_of_int (G.V.label e)
-      ) (SV.elements s))
-  in
-  Printf.eprintf "inital set %s\n" (print_set vertex_set);
+  let part s w = fst(SV.partition (fun e -> e >= w) s) in
   SV.iter (fun s ->
     (* Build the subgraph induced by s and following nodes in the ordering *)
-    Printf.eprintf "selected element %d\n" (G.V.label s);
     let subset = SV.add s (part vertex_set s) in
-    Printf.eprintf "subset %s\n" (print_set subset);
-    let subgraph = subgraph_ g subset in
-    if G.nb_edges subgraph > 0 then begin
-      let scc = G.Components.scc_list subgraph in
-      (* Find the strongly connected component in the subgraph
-       * that contains the least node according to the ordering *)
-      let minnode = SV.min_elt subset in
-      Printf.eprintf "minnode %d\n" (G.V.label minnode);
-      let mincomp = List.find (fun l -> List.mem minnode l) scc in
-      Printf.eprintf "mincomp %s\n" (print_set ((to_set mincomp)));
-      (* smallest node in the component according to the ordering *)
-      let startnode = minnode in
-      let component = subgraph_ subgraph (to_set mincomp) in
-      G.dot_output component (Printf.sprintf "test-component%d.dot" (G.V.label s));
+    let subgraph = extract_subgraph g subset in
+    let scc = G.Components.scc_list subgraph in
+    (* Find the strongly connected component in the subgraph
+     * that contains the least node according to the ordering *)
+    let minnode = SV.min_elt subset in
+    let mincomp = List.find (fun l -> List.mem minnode l) scc in
+    (* smallest node in the component according to the ordering *)
+    let component = extract_subgraph subgraph (to_set mincomp) in
+    if G.nb_edges component > 0 then begin
       G.iter_vertex (fun node ->
-        Hashtbl.add blocked node false;
-        Hashtbl.add b node [];
+        Hashtbl.replace blocked node false;
+        Hashtbl.replace b node [];
       ) component;
-      ignore(circuit startnode startnode component);
-    end else
-      Printf.eprintf "No edges to consider\n"
+      ignore(circuit minnode minnode component);
+    end
   ) vertex_set;
 
-  !result
+  List.rev !result
 ;;
 
-let g = G.Rand.graph ~v:5 ~e:10 () in
-G.dot_output g "test.dot";
+if Array.length Sys.argv < 3 then begin
+  Printf.printf "usage: %s num_vertices [v1,v2...]\n" Sys.argv.(0);
+  exit 1;
+end;
+
+let v = int_of_string (Sys.argv.(1)) in
+let g = G.create ~size:v () in
+
+let a = Array.init v G.V.create in
+
+for i = 2 to Array.length Sys.argv - 1 do
+  let v1, v2 = String.split Sys.argv.(i) "," in
+  G.add_edge g a.(int_of_string v1) a.(int_of_string v2);
+done;
+
 let ll = find_all_cycles_johnson g in
 List.iter (fun path ->
-  Printf.printf "path : %s\n" 
+  Printf.printf "%s\n" 
   (String.join " " (List.map (fun e -> string_of_int (G.V.label e)) path))
 ) ll