mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2026-01-28 11:54:51 -05:00
some benchmarks for graphs
This commit is contained in:
parent
73cb338ba9
commit
9cddc2bcf1
2 changed files with 76 additions and 0 deletions
|
|
@ -1032,6 +1032,81 @@ module Thread = struct
|
||||||
)
|
)
|
||||||
end
|
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 Alloc = struct
|
||||||
module type ALLOC_ARR = sig
|
module type ALLOC_ARR = sig
|
||||||
type 'a t
|
type 'a t
|
||||||
|
|
|
||||||
|
|
@ -273,6 +273,7 @@ val scc : ?tbl:('v, 'v scc_state) table ->
|
||||||
in the graph.
|
in the graph.
|
||||||
Uses {{: https://en.wikipedia.org/wiki/Tarjan's_strongly_connected_components_algorithm} Tarjan's algorithm}
|
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
|
@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}
|
(** {2 Pretty printing in the DOT (graphviz) format}
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue