Remaining Ocaml code for Chapter 4, 6

ch4/hierholzer.ml

@@ -0,0 +1,33 @@
+open Scanf
+open Printf
+
+type graph = int array array (* Adjacency List representation *)
+
+let hierholzer (adj : graph) (start : int) : int list =
+  let n = Array.length adj in
+  let idx = Array.make n 0 in
+  let rec iter path = function
+    | [] -> path
+    | u :: stack' as stack ->
+      if idx.(u) < Array.length adj.(u) then begin
+        let v = adj.(u).(idx.(u)) in
+        idx.(u) <- idx.(u) + 1;
+        iter path (v :: stack)
+      end else
+        iter (u :: path) stack' in
+  iter [] [start]
+
+
+let () =
+  let adj = [|
+    [1; 6];
+    [2];
+    [3; 4];
+    [0];
+    [5];
+    [0; 2];
+    [5];
+  |] |> Array.map Array.of_list in
+  let answer = hierholzer adj 0 in
+  answer |> List.iter (fun u -> printf "%c " (char_of_int (int_of_char 'A' + u)));
+  printf "\n"

ch4/traversal/UVa11838.ml

@@ -3,6 +3,47 @@ open Printf
 
 let range n = Array.init n (fun x -> x)
 
+type graph = int list array (* Adjacency List representation *)
+
+(** Returns a list of all strongly connected components of the directed graph *)
+let tarjan_scc (adj : graph) : int list list =
+  let n = Array.length adj in
+  let low = Array.make n 0 in
+  let num = Array.make n (-1) in
+  let counter = ref 0 in
+  let stack = ref [] in
+  let on_stack = Array.make n false in
+  let sccs = ref [] in
+  let rec visit u =
+    low.(u) <- !counter;
+    num.(u) <- !counter;
+    incr counter;
+    stack := u :: !stack;
+    on_stack.(u) <- true;
+    adj.(u) |> List.iter (fun v ->
+      if num.(v) = -1 then begin
+        visit v;
+        low.(u) <- min low.(u) low.(v)
+      end
+      else if on_stack.(v) then
+        low.(u) <- min low.(u) num.(v)
+    );
+    if low.(u) = num.(u) then begin
+      let rec pop_scc acc = function
+        | hd :: tl ->
+          if hd = u then hd :: acc, tl
+          else pop_scc (hd :: acc) tl
+        | [] -> assert false
+      in
+      let scc, stack' = pop_scc [] !stack in
+      stack := stack';
+      scc |> List.iter (fun v -> on_stack.(v) <- false);
+      sccs := scc :: !sccs
+    end
+  in
+  range n |> Array.iter (fun u -> if num.(u) = -1 then visit u);
+  !sccs
+
 let kosaraju adj_list adj_list_t =
   let n = Array.length adj_list in
   let visited = Array.make n false in

ch4/traversal/articulation.ml

@@ -0,0 +1,63 @@
+open Scanf
+open Printf
+
+type graph = int list array (* Adjacency List representation *)
+
+let range n = List.init n (fun x -> x)
+
+(** Returns a list of all articulation points and a list of all bridges of the
+    simple graph.
+    For multigraphs, store edge ids to the adjacency lists to check for
+    bidirectional edges instead of using [parent] *)
+let articulation_point_and_bridge (adj : graph) : int list * (int*int) list =
+  let n = Array.length adj in
+  let low = Array.make n 0 in
+  let num = Array.make n (-1) in
+  let parent = Array.make n (-1) in
+  let counter = ref 0 in
+  let rec visit u =
+    low.(u) <- !counter;
+    num.(u) <- !counter;
+    incr counter;
+    adj.(u) |> List.iter (fun v ->
+      if num.(v) = -1 then begin
+        parent.(v) <- u;
+        visit v;
+        low.(u) <- min low.(u) low.(v)
+      end
+      else if v <> parent.(u) then (** Use edge id for multigraphs *)
+        low.(u) <- min low.(u) num.(v)
+    )
+  in
+  range n |> List.iter (fun u ->
+    if num.(u) = -1 then begin
+      counter := 0;
+      visit u
+    end
+  );
+  let articulation_points = range n |> List.filter (fun u ->
+    if num.(u) = 0 then (* special case for root *)
+      adj.(u) |> List.filter (fun v -> parent.(v) = u) |> List.length > 1
+    else adj.(u) |> List.exists (fun v -> parent.(v) = u && low.(v) >= num.(u))
+  ) in
+  let bridges = range n |> List.map (fun u ->
+    adj.(u)
+      |> List.filter (fun v -> parent.(v) = u && low.(v) > num.(u))
+      |> List.map (fun v -> (u, v))
+  ) |> List.concat in
+  articulation_points, bridges
+
+let () =
+  let ic = Scanning.open_in "articulation_in.txt" in
+  let sc = object method nf = bscanf ic end in
+  let n = sc#nf " %d " (fun x -> x) in
+  let adj = Array.init n (fun _ ->
+    sc#nf " %d " (fun degree ->
+      List.init degree (fun _ -> sc#nf " %d %d " (fun v w -> v))) (* Ignoring weight *)
+  ) in
+  printf "Articulation Points & Bridges (the input graph must be UNDIRECTED)\n";
+  let aps, bridges = articulation_point_and_bridge adj in
+  printf "Bridges:\n";
+  bridges |> List.iter (fun (u, v) -> printf " Edge (%d, %d) is a bridge\n" u v);
+  printf "Articulation Points:\n";
+  aps |> List.iter (printf " Vertex %d\n");

ch4/traversal/cyclecheck.ml

@@ -0,0 +1,47 @@
+open Scanf
+open Printf
+
+type graph = int list array (* Adjacency List representation *)
+
+type vertex_state = White | Gray | Black
+
+let graph_check (adj : graph) =
+  let n = Array.length adj in
+  let color = Array.make n White in
+  let parent = Array.make n (-1) in
+  let bidirectionals = ref [] in
+  let backs = ref [] in
+  let forward_cross = ref [] in
+  let rec visit u =
+    color.(u) <- Gray;
+    adj.(u) |> List.iter (fun v ->
+      match color.(v) with
+      | White -> parent.(v) <- u; visit v
+      | Gray ->
+        if v = parent.(u) then bidirectionals := (u, v) :: !bidirectionals
+        else backs := (u, v) :: !backs
+      | Black -> forward_cross := (u, v) :: !forward_cross
+    );
+    color.(u) <- Black
+  in
+  List.init n (fun x -> x) |> List.iter (fun u -> if color.(u) = White then visit u);
+  !bidirectionals, !backs, !forward_cross
+
+let () =
+  let ic = Scanning.open_in "scc_in.txt" in
+  let sc = object method nf = bscanf ic end in
+  let n = sc#nf " %d " (fun x -> x) in
+  let adj = Array.init n (fun _ ->
+    sc#nf " %d " (fun degree ->
+      List.init degree (fun _ -> sc#nf " %d %d " (fun v w -> v))) (* Ignoring weight *)
+  ) in
+  printf "Graph Edges Property Check\n";
+  let bidirectionals, backs, forward_cross = graph_check adj in
+  bidirectionals |> List.iter (fun (u, v) ->
+    printf " Bidirectional (%d, %d) - (%d, %d)\n" u v v u);
+  backs |> List.iter (fun (u, v) ->
+    printf " Back Edge (%d, %d) (Cycle)\n" u v
+  );
+  forward_cross |> List.iter (fun (u, v) ->
+    printf " Forward/Cross Edge (%d, %d)\n" u v
+  );

ch4/traversal/dfs_cc.ml

@@ -21,198 +21,21 @@ let dfs (adj : graph) : int list list =
     else (visit [] u |> List.rev) :: components
   ) [] |> List.rev
 
-(* Returns an array of colors of the vertices *)
-let floodfill (adj : graph) : int array =
-  let n = Array.length adj in
-  let label = Array.make n (-1) in
-  let rec visit u color =
-    label.(u) <- color;
-    adj.(u) |> List.iter (fun v ->
-      if label.(v) = -1 then visit v color
-    )
-  in
-  let ncc = ref 0 in
-  for u = 0 to n - 1 do
-    if label.(u) = -1 then begin
-      incr ncc;
-      visit u !ncc
-    end
-  done;
-  label
-
-(** Return a topological ordering of the DAG *)
-let topo_sort (adj : graph) : int list =
-  let n = Array.length adj in
-  let visited = Array.make n false in
-  let rec visit order u =
-    visited.(u) <- true;
-    u ::
-      (adj.(u) |> List.fold_left (fun order v ->
-        if visited.(v) then order
-        else visit order v
-      ) order)
-  in
-  range n |> List.fold_left (fun acc u ->
-    if visited.(u) then acc
-    else visit acc u 
-  ) []
-
-type vertex_state = White | Gray | Black
-
-let graph_check (adj : graph) =
-  let n = Array.length adj in
-  let color = Array.make n White in
-  let parent = Array.make n (-1) in
-  let bidirectionals = ref [] in
-  let backs = ref [] in
-  let forward_cross = ref [] in
-  let rec visit u =
-    color.(u) <- Gray;
-    adj.(u) |> List.iter (fun v ->
-      match color.(v) with
-      | White -> parent.(v) <- u; visit v
-      | Gray ->
-        if v = parent.(u) then bidirectionals := (u, v) :: !bidirectionals
-        else backs := (u, v) :: !backs
-      | Black -> forward_cross := (u, v) :: !forward_cross
-    );
-    color.(u) <- Black
-  in
-  range n |> List.iter (fun u -> if color.(u) = White then visit u);
-  !bidirectionals, !backs, !forward_cross
-
-(** Returns a list of all articulation points and a list of all bridges of the
-    simple graph.
-    For multigraphs, store edge ids to the adjacency lists to check for
-    bidirectional edges instead of using [parent] *)
-let articulation_point_and_bridge (adj : graph) : int list * (int*int) list =
-  let n = Array.length adj in
-  let low = Array.make n 0 in
-  let num = Array.make n (-1) in
-  let parent = Array.make n (-1) in
-  let counter = ref 0 in
-  let rec visit u =
-    low.(u) <- !counter;
-    num.(u) <- !counter;
-    incr counter;
-    adj.(u) |> List.iter (fun v ->
-      if num.(v) = -1 then begin
-        parent.(v) <- u;
-        visit v;
-        low.(u) <- min low.(u) low.(v)
-      end
-      else if v <> parent.(u) then (** Use edge id for multigraphs *)
-        low.(u) <- min low.(u) num.(v)
-    )
-  in
-  range n |> List.iter (fun u ->
-    if num.(u) = -1 then begin
-      counter := 0;
-      visit u
-    end
-  );
-  let articulation_points = range n |> List.filter (fun u ->
-    if num.(u) = 0 then (* special case for root *)
-      adj.(u) |> List.filter (fun v -> parent.(v) = u) |> List.length > 1
-    else adj.(u) |> List.exists (fun v -> parent.(v) = u && low.(v) >= num.(u))
-  ) in
-  let bridges = range n |> List.map (fun u ->
-    adj.(u)
-      |> List.filter (fun v -> parent.(v) = u && low.(v) > num.(u))
-      |> List.map (fun v -> (u, v))
-  ) |> List.concat in
-  articulation_points, bridges
-
-(** Returns a list of all strongly connected components of the directed graph *)
-let tarjan_scc (adj : graph) : int list list =
-  let n = Array.length adj in
-  let low = Array.make n 0 in
-  let num = Array.make n (-1) in
-  let counter = ref 0 in
-  let stack = ref [] in
-  let on_stack = Array.make n false in
-  let sccs = ref [] in
-  let rec visit u =
-    low.(u) <- !counter;
-    num.(u) <- !counter;
-    incr counter;
-    stack := u :: !stack;
-    on_stack.(u) <- true;
-    adj.(u) |> List.iter (fun v ->
-      if num.(v) = -1 then begin
-        visit v;
-        low.(u) <- min low.(u) low.(v)
-      end
-      else if on_stack.(v) then
-        low.(u) <- min low.(u) num.(v)
-    );
-    if low.(u) = num.(u) then begin
-      let rec pop_scc acc = function
-        | hd :: tl ->
-          if hd = u then hd :: acc, tl
-          else pop_scc (hd :: acc) tl
-        | [] -> assert false
-      in
-      let scc, stack' = pop_scc [] !stack in
-      stack := stack';
-      scc |> List.iter (fun v -> on_stack.(v) <- false);
-      sccs := scc :: !sccs
-    end
-  in
-  range n |> List.iter (fun u -> if num.(u) = -1 then visit u);
-  !sccs
-
-let print message =
-  printf "==================================\n";
-  printf "%s\n" message;
-  printf "==================================\n"
-
 
 let () =
-  let ic = Scanning.open_in "01_in.txt" in
+  let ic = Scanning.open_in "dfs_cc_in.txt" in
   let sc = object method nf = bscanf ic end in
   let n = sc#nf " %d " (fun x -> x) in
   let adj = Array.init n (fun _ ->
     sc#nf " %d " (fun degree ->
       List.init degree (fun _ -> sc#nf " %d %d " (fun v w -> v))) (* Ignoring weight *)
   ) in
 
-  print "Standard DFS Demo (the input graph must be UNDIRECTED)";
+  printf "Standard DFS Demo (the input graph must be UNDIRECTED)\n";
   let ccs = dfs adj in
   ccs |> List.iteri (fun i component ->
     printf "CC %d:" (i + 1);
     component |> List.iter (printf " %d");
     printf "\n"
   );
   ccs |> List.length |> printf "There are %d connected components\n";
-
-  print "Flood Fill Demo (the input graph must be UNDIRECTED)";
-  floodfill adj |> Array.iteri (printf "Vertex %d has color %d\n");
-
-  print "Topological Sort (the input graph must be DAG)";
-  topo_sort adj |> List.iter (printf " %d"); printf "\n";
-
-  print "Graph Edges Property Check";
-  let bidirectionals, backs, forward_cross = graph_check adj in
-  bidirectionals |> List.iter (fun (u, v) ->
-    printf " Bidirectional (%d, %d) - (%d, %d)\n" u v v u);
-  backs |> List.iter (fun (u, v) ->
-    printf " Back Edge (%d, %d) (Cycle)\n" u v
-  );
-  forward_cross |> List.iter (fun (u, v) ->
-    printf " Forward/Cross Edge (%d, %d)\n" u v
-  );
-
-  print "Articulation Points & Bridges (the input graph must be UNDIRECTED)";
-  let aps, bridges = articulation_point_and_bridge adj in
-  printf "Bridges:\n";
-  bridges |> List.iter (fun (u, v) -> printf " Edge (%d, %d) is a bridge\n" u v);
-  printf "Articulation Points:\n";
-  aps |> List.iter (printf " Vertex %d\n");
-
-  print "Strongly Connected Components (the input graph must be DIRECTED)";
-  tarjan_scc adj |> List.iteri (fun i scc ->
-    printf "SCC %d:" (i + 1);
-    scc |> List.iter (printf " %d");
-    printf "\n"
-  )