From 9cddc2bcf164ca6dafb8267fc6443496b4ddefc1 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 14 Dec 2015 14:55:39 +0100
Subject: [PATCH] some benchmarks for graphs

---
 benchs/run_benchs.ml | 75 ++++++++++++++++++++++++++++++++++++++++++++
 src/data/CCGraph.mli |  1 +
 2 files changed, 76 insertions(+)

diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml
index 147ea507..ed1605f2 100644
--- a/benchs/run_benchs.ml
+++ b/benchs/run_benchs.ml
@@ -1032,6 +1032,81 @@ module Thread = struct
   )
 end
 
+module Graph = struct
+
+  (* divisors graph *)
+  let div_children_ i =
+    (* divisors of [i] that are [>= j] *)
+    let rec aux j i yield =
+      if j < i
+      then (
+        if (i mod j = 0) then yield (i,j);
+        aux (j+1) i yield
+      )
+    in
+    aux 1 i
+
+  let div_graph_ = {CCGraph.
+    origin=fst;
+    dest=snd;
+    children=div_children_
+  }
+
+  module H = Hashtbl.Make(CCInt)
+
+  let dfs_raw n () =
+    let explored = H.create (n+10) in
+    let st = Stack.create() in
+    let res = ref 0 in
+    Stack.push n st;
+    while not (Stack.is_empty st) do
+      let i = Stack.pop st in
+      if not (H.mem explored i) then (
+        H.add explored i ();
+        incr res;
+        div_children_ i (fun (_,j) -> Stack.push j st);
+      )
+      done;
+    !res
+
+  let dfs_ n () =
+    let tbl = CCGraph.mk_table ~eq:CCInt.equal ~hash:CCInt.hash (n+10) in
+    CCGraph.Traverse.dfs ~tbl ~graph:div_graph_
+      (Sequence.return n)
+    |> Sequence.fold (fun acc _ -> acc+1) 0
+
+  let dfs_event n () =
+    let tbl = CCGraph.mk_table ~eq:CCInt.equal ~hash:CCInt.hash (n+10) in
+    CCGraph.Traverse.Event.dfs ~tbl ~graph:div_graph_
+      (Sequence.return n)
+    |> Sequence.fold
+      (fun acc -> function
+        | `Enter _ -> acc+1
+        | `Exit _
+        | `Edge _ -> acc)
+      0
+
+  let bench_dfs n =
+    assert (
+      let n1 = dfs_raw n () in
+      let n2 = dfs_ n ()  in
+      let n3 = dfs_event n () in
+      n1 = n2 &&
+      n2 = n3);
+    B.throughputN 2 ~repeat
+      [ "raw", dfs_raw n, ()
+      ; "ccgraph", dfs_ n, ()
+      ; "ccgraph_event", dfs_event n, ()
+      ]
+
+  let () =
+    B.Tree.register ("graph" @>>>
+      [ "dfs" @>>
+        app_ints bench_dfs [100; 1000; 10_000; 50_000; 100_000; 500_000]
+      ]
+    )
+end
+
 module Alloc = struct
   module type ALLOC_ARR = sig
     type 'a t
diff --git a/src/data/CCGraph.mli b/src/data/CCGraph.mli
index e59fc5ea..1e37ac25 100644
--- a/src/data/CCGraph.mli
+++ b/src/data/CCGraph.mli
@@ -273,6 +273,7 @@ val scc : ?tbl:('v, 'v scc_state) table ->
     in the graph.
     Uses {{: https://en.wikipedia.org/wiki/Tarjan's_strongly_connected_components_algorithm} Tarjan's algorithm}
     @param tbl table used to map nodes to some hidden state
+    @raise Sequence_once if the result is iterated on more than once.
     *)
 
 (** {2 Pretty printing in the DOT (graphviz) format}