diff --git a/bench/dune b/bench/dune index 4b3c0cc..40b63a2 100644 --- a/bench/dune +++ b/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))) diff --git a/dowsindex b/dowsindex deleted file mode 100755 index e0f4d0b..0000000 --- a/dowsindex +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/sh -exec dune exec dowsindex -- "$@" diff --git a/bench/bench.ml b/stat/bench.ml similarity index 57% rename from bench/bench.ml rename to stat/bench.ml index 7aafed7..b0a271b 100644 --- a/bench/bench.ml +++ b/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 "@[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 + "@[@{@[%a@]:@}@;\ + <1 2>@[@{With features:@}@;\ + <1 2>%a@;\ + @;\ + @{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 "@[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 - "@[@{@[%a@]:@}@;\ - <1 2>@[@{With features:@}@;\ - <1 2>%a@;\ - @;\ - @{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 "@[@{%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 diff --git a/stat/compare.ml b/stat/compare.ml new file mode 100644 index 0000000..5fa8868 --- /dev/null +++ b/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) diff --git a/stat/dune b/stat/dune new file mode 100644 index 0000000..ab65cf9 --- /dev/null +++ b/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))) diff --git a/stat/main.ml b/stat/main.ml new file mode 100644 index 0000000..5700716 --- /dev/null +++ b/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