Feat: New stat folder for the tools to make stat on dowsing

- Move the previous bench tool ther
- Now compare take a list of file to compare

bench/dune

@@ -25,9 +25,3 @@
   (libraries common acic bechamel bechamel-notty bechamel-js notty.unix cmdliner)
   (flags
     (:standard -open Common -open Utils)))
-
-(executable
- (name bench)
- (libraries common acic db bechamel bechamel-notty notty.unix cmdliner printbox printbox-text)
-  (flags
-    (:standard -open Common -open Utils)))

bench/bench.ml → stat/bench.ml

@@ -2,6 +2,47 @@ open Containers
 open Bechamel
 open Toolkit
 
+type result = {
+  time : float;
+  time_r_square : float;
+  ac : int;
+  arrow : int;
+  timeout : int;
+}
+
+let pp_result fmt result =
+  Format.fprintf fmt "@[<v>Time: %.2f ms@;AC sol: %i@;Arrow: %i@;Timeout: %i@]"
+    (result.time /. 1_000_000.)
+    result.ac result.arrow result.timeout
+
+type data = { ty : Type.t; feats : result; no_feats : result }
+
+let make_comparaison_matrix name_1 result_1 name_2 result_2 =
+  let grid = Array.init 3 (fun _ -> Array.make 3 (PrintBox.text "")) in
+  grid.(1).(0) <- PrintBox.text name_1;
+  grid.(2).(0) <- PrintBox.text name_2;
+  grid.(0).(1) <- PrintBox.text name_1;
+  grid.(0).(2) <- PrintBox.text name_2;
+  let ratio12 = result_1.time /. result_2.time in
+  let ratio21 = result_2.time /. result_1.time in
+  grid.(1).(2) <- PrintBox.center_hv @@ PrintBox.sprintf "x%.2f" ratio21;
+  grid.(2).(1) <- PrintBox.center_hv @@ PrintBox.sprintf "x%.2f" ratio12;
+  PrintBox.grid grid |> PrintBox.frame
+
+let pp_data fmt data =
+  Format.fprintf fmt
+    "@[<v>@{<bold>@[%a@]:@}@;\
+     <1 2>@[<v>@{<bold>With features:@}@;\
+     <1 2>%a@;\
+     @;\
+     @{<bold>Without features:@}@;\
+     <1 2>%a@;\
+     @;\
+     %a@]@]"
+    Type.pp data.ty pp_result data.feats pp_result data.no_feats
+    (PrintBox_text.pp_with ~style:true)
+    (make_comparaison_matrix "Feat" data.feats "No feat" data.no_feats)
+
 let make_test idx_file with_feats ty =
   let name =
     Format.sprintf "%s_%a" (if with_feats then "wf" else "nf") Type.pp ty
@@ -34,50 +75,6 @@ let cfg =
   Benchmark.cfg ()
 
 let ols = Analyze.ols ~bootstrap:0 ~r_square:true ~predictors:[| Measure.run |]
-
-type result = {
-  time : float;
-  time_r_square : float;
-  ac : int;
-  arrow : int;
-  timeout : int;
-}
-
-type data = { ty : Type.t; feats : result; no_feats : result }
-
-module B = PrintBox
-
-let make_comparaison_matrix name_1 result_1 name_2 result_2 =
-  let grid = Array.init 3 (fun _ -> Array.make 3 (B.text "")) in
-  grid.(1).(0) <- B.text name_1;
-  grid.(2).(0) <- B.text name_2;
-  grid.(0).(1) <- B.text name_1;
-  grid.(0).(2) <- B.text name_2;
-  let ratio12 = result_1.time /. result_2.time in
-  let ratio21 = result_2.time /. result_1.time in
-  grid.(1).(2) <- B.center_hv @@ B.sprintf "x%.2f" ratio21;
-  grid.(2).(1) <- B.center_hv @@ B.sprintf "x%.2f" ratio12;
-  B.grid grid |> B.frame
-
-let pp_result fmt result =
-  Format.fprintf fmt "@[<v>Time: %.2f ms@;AC sol: %i@;Arrow: %i@;Timeout: %i@]"
-    (result.time /. 1_000_000.)
-    result.ac result.arrow result.timeout
-
-let pp_data fmt data =
-  Format.fprintf fmt
-    "@[<v>@{<bold>@[%a@]:@}@;\
-     <1 2>@[<v>@{<bold>With features:@}@;\
-     <1 2>%a@;\
-     @;\
-     @{<bold>Without features:@}@;\
-     <1 2>%a@;\
-     @;\
-     %a@]@]"
-    Type.pp data.ty pp_result data.feats pp_result data.no_feats
-    (PrintBox_text.pp_with ~style:true)
-    (make_comparaison_matrix "Feat" data.feats "No feat" data.no_feats)
-
 let get_singleton = function [ e ] -> e | _ -> failwith "Not a singleton"
 
 let get_const result instance =
@@ -120,77 +117,55 @@ let stat idx_file save_file tys =
   | None -> ()
   | Some file -> CCIO.with_out file (fun cout -> Marshal.to_channel cout res [])
 
-let _grid_diff base result =
-  let grid = Array.init 5 (fun _ -> Array.make 3 (B.text "")) in
-  grid.(0).(1) <- B.center_hv @@ B.text "Base";
-  grid.(0).(2) <- B.center_hv @@ B.text "New";
-  List.iteri
-    (fun i w -> grid.(i + 1).(0) <- B.text @@ Measure.label w)
-    instances;
-  grid.(1).(1) <- B.center_hv @@ B.sprintf "%.2f" base.time;
-  grid.(1).(2) <- B.center_hv @@ B.sprintf "%.2f" result.time;
-  grid.(2).(1) <- B.center_hv @@ B.sprintf "%i" base.ac;
-  grid.(2).(2) <- B.center_hv @@ B.sprintf "%i" result.ac;
-  grid.(3).(1) <- B.center_hv @@ B.sprintf "%i" base.arrow;
-  grid.(3).(2) <- B.center_hv @@ B.sprintf "%i" result.arrow;
-  grid.(4).(1) <- B.center_hv @@ B.sprintf "%i" base.timeout;
-  grid.(4).(2) <- B.center_hv @@ B.sprintf "%i" result.timeout;
-  B.grid grid |> B.frame
-
 let ratio x y =
   let open Float.Infix in
   let r = x /. y in
   if r < 0.1 then
-    B.sprintf_with_style
-      { B.Style.default with bold = true; bg_color = Some Red }
+    PrintBox.sprintf_with_style
+      { PrintBox.Style.default with bold = true; bg_color = Some Red }
       "%.2f" r
   else if r < 0.5 then
-    B.sprintf_with_style
-      { B.Style.default with bold = true; fg_color = Some Red }
+    PrintBox.sprintf_with_style
+      { PrintBox.Style.default with bold = true; fg_color = Some Red }
       "%.2f" r
   else if r < 1. then
-    B.sprintf_with_style
-      { B.Style.default with bold = true; fg_color = Some Yellow }
+    PrintBox.sprintf_with_style
+      { PrintBox.Style.default with bold = true; fg_color = Some Yellow }
       "%.2f" r
   else if r < 1.5 then
-    B.sprintf_with_style
-      { B.Style.default with bold = true; fg_color = Some Green }
+    PrintBox.sprintf_with_style
+      { PrintBox.Style.default with bold = true; fg_color = Some Green }
       "%.2f" r
   else
-    B.sprintf_with_style
-      { B.Style.default with bold = true; bg_color = Some Green }
+    PrintBox.sprintf_with_style
+      { PrintBox.Style.default with bold = true; bg_color = Some Green }
       "%.2f" r
 
 let compare base idx_file =
   CCFormat.set_color_default true;
   let base = CCIO.with_in base (fun cin -> Marshal.from_channel cin) in
   let grid =
-    Array.init (List.length base + 1) (fun _ -> Array.make 4 (B.text ""))
+    Array.init (List.length base + 1) (fun _ -> Array.make 4 (PrintBox.text ""))
   in
-  grid.(0).(1) <- B.center_hv @@ B.text "Base";
-  grid.(0).(2) <- B.center_hv @@ B.text "New";
-  grid.(0).(3) <- B.center_hv @@ B.text "Ratio";
+  grid.(0).(1) <- PrintBox.center_hv @@ PrintBox.text "Base";
+  grid.(0).(2) <- PrintBox.center_hv @@ PrintBox.text "New";
+  grid.(0).(3) <- PrintBox.center_hv @@ PrintBox.text "Ratio";
   List.iteri
     (fun i res ->
       let ty = res.ty in
       let data = get_data idx_file ty in
-      grid.(i + 1).(0) <- B.asprintf "%a" Type.pp ty;
+      grid.(i + 1).(0) <- PrintBox.asprintf "%a" Type.pp ty;
       grid.(i + 1).(1) <-
-        B.center_hv @@ B.sprintf "%.2f ms" (res.feats.time /. 1_000_000.);
+        PrintBox.center_hv
+        @@ PrintBox.sprintf "%.2f ms" (res.feats.time /. 1_000_000.);
       grid.(i + 1).(2) <-
-        B.center_hv @@ B.sprintf "%.2f ms" (data.feats.time /. 1_000_000.);
-      grid.(i + 1).(3) <- B.center_hv @@ ratio res.feats.time data.feats.time)
+        PrintBox.center_hv
+        @@ PrintBox.sprintf "%.2f ms" (data.feats.time /. 1_000_000.);
+      grid.(i + 1).(3) <-
+        PrintBox.center_hv @@ ratio res.feats.time data.feats.time)
     base;
-  let grid = B.grid grid in
+  let grid = PrintBox.grid grid in
   Format.printf "@[%a@]@." (PrintBox_text.pp_with ~style:true) grid
-(* List.iter *)
-(*   (fun res -> *)
-(*     let ty = res.ty in *)
-(*     let data = get_data idx_file ty in *)
-(*     Format.printf "@[<v>@{<bold>%a@}@;<1 2>%a@]@." Type.pp ty *)
-(*       (PrintBox_text.pp_with ~style:true) *)
-(*       (grid_diff res.feats data.feats)) *)
-(*   base *)
 
 open Cmdliner
 
@@ -213,27 +188,3 @@ let stat =
   let doc = "Generate statistics" in
   let info = Cmd.info "stat" ~doc in
   Cmd.v info Term.(const stat $ idx_file $ save_file $ tys)
-
-let base_file =
-  let docv = "BASE" in
-  let doc = "Load the base to compare to." in
-  Arg.(value & pos 0 file "" & info [] ~docv ~doc)
-
-let compare =
-  let doc =
-    "Compare the curent state with a previous state. The databased used must \
-     be the same for the test to be relevant."
-  in
-  let info = Cmd.info "compare" ~doc in
-  Cmd.v info Term.(const compare $ base_file $ idx_file)
-
-let cmds = [ stat; compare ]
-
-let main_cmd, main_info =
-  let doc = "Benchmark utils for Dowsing" in
-  ( Term.(ret (const (`Error (true, "no command")))),
-    Cmd.info "bench" ~sdocs:Manpage.s_common_options ~doc )
-
-let () =
-  Logs.(set_reporter @@ format_reporter ());
-  exit @@ Cmd.eval @@ Cmd.group ~default:main_cmd main_info cmds

stat/compare.ml

@@ -0,0 +1,76 @@
+open Containers
+
+let ratio x y =
+  let open Float.Infix in
+  let r = x /. y in
+  if r < 0.5 then
+    PrintBox.sprintf_with_style
+      { PrintBox.Style.default with bold = true; bg_color = Some Red }
+      "%.2f x%.2f" (y /. 1_000_000.) r
+  else if r < 0.7 then
+    PrintBox.sprintf_with_style
+      { PrintBox.Style.default with bold = true; fg_color = Some Red }
+      "%.2f x%.2f" (y /. 1_000_000.) r
+  else if r < 0.99 then
+    PrintBox.sprintf_with_style
+      { PrintBox.Style.default with bold = true; fg_color = Some Yellow }
+      "%.2f x%.2f" (y /. 1_000_000.) r
+  else if r < 1.01 then
+    PrintBox.sprintf_with_style PrintBox.Style.default "%.2f x%.2f"
+      (y /. 1_000_000.) r
+  else if r < 1.5 then
+    PrintBox.sprintf_with_style
+      { PrintBox.Style.default with bold = true; fg_color = Some Green }
+      "%.2f x%.2f" (y /. 1_000_000.) r
+  else
+    PrintBox.sprintf_with_style
+      { PrintBox.Style.default with bold = true; bg_color = Some Green }
+      "%.2f x%.2f" (y /. 1_000_000.) r
+
+let get_name file =
+  let file = Filename.basename file in
+  try Filename.chop_extension file with Invalid_argument _ -> file
+
+let compare results =
+  let results =
+    List.map
+      (fun file -> (get_name file, CCIO.with_in file Marshal.from_channel))
+      results
+  in
+  let _, base = List.hd results in
+  let grid =
+    Array.init
+      (List.length base + 1)
+      (fun _ -> Array.make (List.length results + 1) (PrintBox.text ""))
+  in
+  List.iteri
+    (fun i (name, _) ->
+      grid.(0).(i + 1) <- PrintBox.center_hv @@ PrintBox.text name)
+    results;
+  List.iteri
+    (fun r { Bench.ty; feats; _ } ->
+      grid.(r + 1).(0) <- PrintBox.asprintf "%a" Type.pp ty;
+      List.iteri
+        (fun c (_, result) ->
+          match List.find_opt (fun e -> Type.equal e.Bench.ty ty) result with
+          | None -> grid.(r + 1).(c + 1) <- PrintBox.text "NA"
+          | Some res ->
+              grid.(r + 1).(c + 1) <- ratio feats.time res.Bench.feats.time)
+        results)
+    (snd base);
+  let grid = PrintBox.grid grid in
+  Format.printf "@[%a@]@." (PrintBox_text.pp_with ~style:true) grid
+
+open Cmdliner
+
+let data =
+  let docv = "DATAS" in
+  Arg.(value & pos_all file [] & info [] ~docv)
+
+let compare =
+  let doc =
+    "Compare the curent state with a previous state. The databased used must \
+     be the same for the test to be relevant."
+  in
+  let info = Cmd.info "compare" ~doc in
+  Cmd.v info Term.(const compare $ data)

stat/dune

@@ -0,0 +1,5 @@
+(executable
+ (name main)
+ (libraries common acic db bechamel bechamel-notty notty.unix cmdliner printbox printbox-text)
+  (flags
+    (:standard -open Common -open Utils)))

stat/main.ml

@@ -0,0 +1,12 @@
+open Cmdliner
+
+let cmds = [ Bench.stat; Compare.compare ]
+
+let main_cmd, main_info =
+  let doc = "Benchmark utils for Dowsing" in
+  ( Term.(ret (const (`Error (true, "no command")))),
+    Cmd.info "bench" ~sdocs:Manpage.s_common_options ~doc )
+
+let () =
+  Logs.(set_reporter @@ format_reporter ());
+  exit @@ Cmd.eval @@ Cmd.group ~default:main_cmd main_info cmds