compare pure signals whose values are functions and side effect signals

react_minibenchmark.ml

(* here the idea is to compare the performance of different ways to accumulate
   updates from a number of updater events into one signal. namely, side
   effectful events vs. combining pure events via E.select *)

open React

(* utilities *)
let add_3 = (+) 3

let timeit_sys (f: unit -> unit) =
  let tt = Sys.time () in
  let () = f () in
  Sys.time () -. tt

let timeit (f: unit -> unit) =
  let tt = Unix.gettimeofday () in
  let () = f () in
  Unix.gettimeofday () -. tt


(* first the pure way of constructing a number signal updated by any of a list
   of updater functional events. this requires first E.select then S.accum *)

let func_evs n : ((int -> int) event * (unit -> unit)) list =
  let rec aux acc n =
    match n with
    | 0 -> acc
    | _ ->
      let adder, fire = E.create () in
      let fire_add_ () = fire ?step:None add_3 in
      aux ((adder, fire_add_) :: acc) (n-1)
  in aux [] n

(* combine by folding a list *)
let comb_func_evs func_e_s =
  let events, _setters = List.split func_e_s in
  (* E.select combines by folding a list. *)
  E.select events

(* optionally, skip E.select when there is only one element *)
let comb_func_ev_shortcut func_e_s =
  let events, _setters = List.split func_e_s in
  (* avoid select if there is only one event to select from  *)
  match events with
  | [e] -> e
  | _ -> failwith "shortcut only possible with a single driver event"

(* optionally, add in some futile intermediates *)
let number_sig_pure n_detours comb_evs =
  let intermediate = E.map (fun x -> x) comb_evs in
  let intermediate2 = E.map (fun x -> x) intermediate in
  let intermediate3 = E.map (fun x -> x) intermediate2 in
  let which_one =
    match n_detours with
    | 0 -> comb_evs
    | 1 -> intermediate
    | 2 -> intermediate2
    | 3 -> intermediate3
    | _ -> failwith "more than 3 intermediates not implemented"
  in S.accum which_one 0


(* now the same thing but using side effects instead of E.select and S.accum.
   guarantee: each event executes its side effect once in every update step it
   fires in *)

let number_sig_set initval : ((int signal) * (unit -> unit)) =
  let signal, setter = S.create initval in
  let add_ () = setter ?step:None (add_3 (S.value signal)) in
  signal, add_

let side_evs n (adder: unit -> unit) : (unit event * (unit -> unit)) list =
  let rec aux acc n =
    match n with
    | 0 -> acc
    | _ ->
      let updater, fire = E.create () in
      let fire_adder () = fire ?step:None (adder ()) in
      aux ((updater, fire_adder) :: acc) (n-1)
  in aux [] n


(* for comparison, do the same thing without reactive programming, instead with
   conventional imperative updates. the difference to the side-effectful event
   version above is not much *)

let imp_updaters n sumref : (unit * (unit -> unit)) list =
  let rec aux acc n =
    match n with
    | 0 -> acc
    | _ ->
      let updater () = sumref := add_3 !sumref in
      (* small hack to make it compatible with the signal types *)
      aux (((), updater) :: acc) (n-1)
  in aux [] n


(* simulation loop *)

let run (fire_fun_array: (unit -> unit) array) num_iterations =
  let rand_index () = Random.int (Array.length fire_fun_array) in
  for i = 0 to num_iterations do
    (* let _wait = Unix.select [] [] [] 1e-9 in  *)
    (* fire a random event trigger *)
    fire_fun_array.(rand_index ()) ()
  done;;


(* 'script'. run all versions. *)
(* adjust the parameters to explore the performance *)
let num_iterations = int_of_float 1e6 in
let num_parallel_updaters = 100 in
let num_pure_intermediates = 0 in
let use_shortcut = true in
let () = Format.fprintf Format.std_formatter
    "%d iterations, %d parallel updaters, %d pure intermediate events,\n\
     %s using shortcut for single-event pure version \n"
    num_iterations num_parallel_updaters num_pure_intermediates
    (if use_shortcut then "" else "not") in
(* pure version *)
let pure_e_s = func_evs num_parallel_updaters in
let num_sig_pure =
  let comb_es =
    match (num_parallel_updaters, use_shortcut) with
    | (1, true) -> comb_func_ev_shortcut pure_e_s
    | _ -> comb_func_evs pure_e_s
  in
  number_sig_pure num_pure_intermediates comb_es
in
(* side effect version *)
let num_sig_side, num_adder = number_sig_set 0 in
let side_e_s = side_evs num_parallel_updaters num_adder in
(* imperative version *)
let num_imp = ref 0 in
let imp_u = imp_updaters num_parallel_updaters num_imp in
(* wrap as thunks for use with timeit *)
let run_pure, run_side, run_imp =
  let thk e_s =
    let ea = Array.of_list (List.map snd e_s) in
    fun () -> run ea num_iterations in
  thk pure_e_s, thk side_e_s, thk imp_u
in
(* actually run, and print timings *)
let rt_pure = timeit run_pure in
let () = print_string "done with the pure signal version\n" in
let rt_side = timeit run_side in
let () = print_string "done with the side effect version\n" in
let rt_imp = timeit run_imp in
let () = print_string "done with the imperative version\n" in
let fp = Format.fprintf Format.std_formatter in
let () = fp "pure runtime: %.3f s\npure end value: %d\n"
    rt_pure (S.value num_sig_pure) in
let () = fp "side effects runtime: %.3f s\nside eff end value: %d\n"
    rt_side (S.value num_sig_side) in
let () = fp "imperative runtime: %.3f s\nimp end value: %d\n"
    rt_imp (!num_imp) in
print_string "done.\n"