removed API calls from Service

lib/pipeline.ml

@@ -319,11 +319,12 @@ let derive_profile ?(indir = "") ?(ns = 0) ~preview ~fast_mode ~no_Ne ~ne_test ~
         |> Repo.shift tree_prefix
         |> Repo.shift "Results_per_tree"
       in
-      (repo_per_tree, post_analyses_res)
+      (repo_per_tree, post_analyses_res, dataset_results_l)
     )
   in
-  let all_repo_per_tree_simu = List.map repo_and_post_analyses_per_tree_simu ~f:(fun (r,p) -> r) |> List.concat in
-  let all_post_analyses_per_tree = List.map repo_and_post_analyses_per_tree_simu ~f:(fun (r,p) -> p) in
+  let all_repo_per_tree_simu = List.concat_map repo_and_post_analyses_per_tree_simu ~f:(fun (r, _, _) -> r) in
+  let all_post_analyses_per_tree = List.map repo_and_post_analyses_per_tree_simu ~f:(fun (_, p, _) -> p) in
+  let all_dataset_results = List.concat_map repo_and_post_analyses_per_tree_simu ~f:(fun (_, _, d) -> d) in
   let profile_prefix = profile.profile_n in
   let repo_post_analyses_all_trees = Post_analyses.repo_post_analyses_all_trees_of_all_post_analyses_per_tree ~all_post_analyses_per_tree ~profile_prefix in
   let repo_post_analyses_all_trees = if only_simu then
@@ -331,15 +332,23 @@ let derive_profile ?(indir = "") ?(ns = 0) ~preview ~fast_mode ~no_Ne ~ne_test ~
     else
       repo_post_analyses_all_trees
   in
-  let repo = repo_of_post_analyses_simu @ all_repo_per_tree_simu @ repo_post_analyses_all_trees in
-  Repo.shift profile_prefix repo
+  let repo =
+    repo_of_post_analyses_simu @ all_repo_per_tree_simu @ repo_post_analyses_all_trees
+    |> Repo.shift profile_prefix
+  in
+  object
+    method repo = repo
+    method dataset_results = all_dataset_results
+  end
 
+let time_logger = Time_logger.create ()
 
 let logger =
   Logger.tee [
     Console_logger.create () ;
     Dot_output.create "dag.dot" ; (*dot -Tpdf example/dag.dot -o dag.pdf*)
     Bistro_utils.Html_logger.create "report.html" ;
+    time_logger#logger ;
   ]
 
 let detection_main ~outdir ~indir ?(np = 2) ?(mem = 2) ~preview ~fast_mode () =
@@ -360,7 +369,7 @@ let validation_main ~outdir ?(indir = "") ?(ns = 0) ?(np = 2) ?(mem = 2) ~previe
   (* simulated trees *)
   let nb_sites = if ns = 0 then (if preview then 20 else 50) else ns in
   let profile = Profile.profile_l_of_splitted_profile ~nb_cat:3 ~nb_sites profile_fn in
-  let sim_repo_l =  derive_profile ~indir ~ns ~preview ~fast_mode ~no_Ne ~ne_test ~no_HaPC ~tree_dir ~profile ~use_concat ~only_simu () in
+  let sim_repo_l = derive_profile ~indir ~ns ~preview ~fast_mode ~no_Ne ~ne_test ~no_HaPC ~tree_dir ~profile ~use_concat ~only_simu () in
   (* real trees *)
   let indir_dataset_l = if indir = "" then [] else parse_input_data indir in
   let dataset_l = indir_dataset_l in
@@ -375,8 +384,9 @@ let validation_main ~outdir ?(indir = "") ?(ns = 0) ?(np = 2) ?(mem = 2) ~previe
     repo_of_dataset_results_l ~dataset_results_l ;
   ] |> List.concat
   in
-  let repo = (Repo.shift "Simulated_datasets" sim_repo_l) @ (Repo.shift "Real_datasets" repo_real_trees) in
-  Repo.build ~outdir ~np ~mem:(`GB mem) ~logger repo
+  let repo = (Repo.shift "Simulated_datasets" sim_repo_l#repo) @ (Repo.shift "Real_datasets" repo_real_trees) in
+  Repo.build ~outdir ~np ~mem:(`GB mem) ~logger repo ;
+  time_logger#report sim_repo_l#dataset_results (Filename.concat outdir "elapsed_time.tsv")
 
 let simulation_command =
   let open Command.Let_syntax in

lib/time_logger.ml

+open Core
+open Bistro_engine
+
+type stats = {
+  elapsed_time : float ;
+}
+
+let create () = object (self)
+  val started = String.Table.create ()
+  val table = String.Table.create ()
+  method event config t = function
+    | Scheduler.Task_started (task, _) ->
+      String.Table.set started (Task.id task) t
+    | Task_ended (Step_result { step }) ->
+      let id = step.id in
+      let start_time = String.Table.find_exn started id in
+      String.Table.set table id {
+        elapsed_time = t -. start_time ;
+      }
+    | Task_ended (Input_check _ | Select_check _ | Map_command_result _)
+    | Init _
+    | Task_ready _
+    | Task_skipped _ -> ()
+
+  method elapsed_time : 'a. 'a Bistro.workflow -> float = fun w ->
+    (String.Table.find_exn table (Bistro.Workflow.id w)).elapsed_time
+  method elapsed_time_of_result : Convergence_detection.result -> string * float option =
+    let f w =
+      let id = Bistro.Workflow.id w in
+      id, Option.map (String.Table.find table (Bistro.Workflow.id w)) ~f:(fun x -> x.elapsed_time)
+    in
+    function
+    | `Pcoc w
+    | `Pcoc_gamma w
+    | `Pcoc_C60 w -> f w
+    | `Diffsel w -> f w
+    | `Identical_LG w
+    | `Identical_WAG w -> f w
+    | `Topological_LG w
+    | `Topological_WAG w -> f w
+    | `Tdg09 w -> f w
+    | `Multinomial w -> f w
+    | `Msd (w, _) -> f w
+  method stop = ()
+  method wait4shutdown = Lwt.return ()
+  method logger = (self :> Scheduler.logger)
+  method report detection_results fn =
+    List.map detection_results ~f:(fun (dataset_res : Convergence_detection.dataset_res) ->
+        let tree_name = dataset_res.tree_prefix in
+        let model_name = dataset_res.model_prefix in
+        List.map dataset_res.res_by_tools ~f:(fun r ->
+            let meth_name = Convergence_detection.meth_string_of_result r in
+            let id, elapsed_time = self#elapsed_time_of_result r in
+            String.concat
+              ~sep:"\t"
+              [ tree_name ; model_name ; meth_name ; id ;
+                Option.value_map ~f:Float.to_string ~default:"NA" elapsed_time ]
+          )
+      )
+    |> List.concat
+    |> Out_channel.write_lines fn
+
+end