Run: generate alignment plots and link to them

lib/run.ml

@@ -20,7 +20,16 @@ let multinomial_method = Detection_method {
     f = Pipeline.multinomial_asymptotic_lrt ;
   }
 
-let candidate_site_report (Detection_method dm) sites =
+let candidate_site_report dataset (Detection_method meth) =
+  let all_queries = Dataset.queries dataset in
+  let sites =
+    Pipeline.ranking
+      ~query_descr:(fun q -> Some q.Dataset.Query.alignment_descr)
+      ~meth:meth.f
+      ~column_label:meth.cpt_column_label
+      ~convergent_species:dataset.Dataset.convergent_species
+      all_queries
+  in
   let f = fun%workflow dest ->
     let module N = Codepitk.Note in
     let module DF = Codepitk.Dataframe in
@@ -30,10 +39,10 @@ let candidate_site_report (Detection_method dm) sites =
       N.to_html note path
       |> Rresult.R.failwith_error_msg
     in
-    let site_page_path i = sprintf "%s_%04d.html" dm.id i in
+    let site_page_path i = sprintf "%s_%04d.html" meth.id i in
     let site_page i s =
       let path = Filename.concat dest (site_page_path i) in
-      let title = sprintf "%s candidate site #%d" dm.name i in
+      let title = sprintf "%s candidate site #%d" meth.name i in
       let alignment_id = Option.value ~default:"NA" s.CS.alignment_id in
       let position = Option.value_map ~f:Int.to_string ~default:"NA" s.CS.pos in
       let score = Option.value_map ~f:Float.to_string ~default:"NA" s.CS.score in
@@ -51,23 +60,46 @@ let candidate_site_report (Detection_method dm) sites =
       note_to_html contents path ;
       if i = 0 then Out_channel.with_file "delme.bin" ~f:(fun oc -> Marshal.to_channel oc s [])
     in
+    let module H = struct
+      open Tyxml.Html
+
+      let table ~labels rows =
+        let open Tyxml.Html in
+        let thead = thead [tr (List.map labels ~f:(fun x -> td [txt x]))] in
+        let rows =
+          List.map rows ~f:(fun cells ->
+              tr (List.map cells ~f:(fun x -> td [x]))
+            )
+        in
+        table ~thead rows
+
+      let link ~href contents = a ~a:[a_href href] [txt contents]
+
+      let opt_cell x ~f = match x with
+        | None -> txt "NA"
+        | Some y -> f y
+
+      let opt_txt x ~f = opt_cell x ~f:(fun x -> txt (f x))
+    end
+    in
     let index =
       let df =
-        DF.make [
-          "Alignment ID", DF.String_opts (Array.map sites ~f:(fun s -> s.CS.alignment_id)) ;
-          "Position", DF.Int_opts (Array.map sites ~f:(fun s -> s.CS.pos)) ;
-          "Score", DF.Float_opts (Array.map sites ~f:(fun s -> s.CS.score)) ;
-          "Infos", DF.Strings (Array.(create ~len:(length sites) "")) ;
-        ]
-        |> Rresult.R.failwith_error_msg
-      in
-      let title = sprintf "Candidate sites for %s method" dm.name in
-      let formatters = Tyxml.Html.[
-          "Infos", fun i _ -> a ~a:[a_href (site_page_path i)] [txt "Details"]
-        ]
+        let labels = ["Alignment ID" ; "Position" ; "Score" ; "Infos"] in
+        let rows = List.init (Array.length sites) ~f:(fun i -> [
+              H.opt_cell sites.(i).CS.alignment_id ~f:(fun id ->
+                  let href = sprintf "../alignments/%s.svg" id in
+                  H.link ~href id
+                ) ;
+              H.opt_txt sites.(i).CS.pos ~f:Int.to_string ;
+              H.opt_txt sites.(i).CS.score ~f:Float.to_string ;
+              H.link ~href:(site_page_path i) "Details"
+            ])
+        in
+        H.table ~labels rows
       in
+      let title = sprintf "Candidate sites for %s method" meth.name in
       N.make ~title N.[
-          dataframe ~formatters df ;
+          table df ;
         ]
     in
     let path fn = Filename.concat dest fn in
@@ -108,22 +140,19 @@ let dataset run =
 let repo run =
   let detection_methods = detection_methods run in
   let d = dataset run in
-  let q = List.hd_exn (Dataset.queries d) in
   let foreach_detection_method (Detection_method meth as dm) =
-    let ranking =
-      Pipeline.ranking
-        ~query_descr:(fun q -> Some q.Dataset.Query.alignment_descr)
-        ~meth:meth.f
-        ~column_label:meth.cpt_column_label
-        ~convergent_species:d.convergent_species
-        (Dataset.queries d)
-    in
-    Repo.[
-      item [meth.id ^ ".cpt"] (meth.f q) ;
-      item [meth.id ^ "_report"] (candidate_site_report dm ranking) ;
-    ]
+    let report = candidate_site_report d dm in
+    Repo.item [meth.id ^ "_report"] report
+  in
+  let foreach_query (q : Dataset.Query.t) =
+    Repo.item
+      ["alignments" ; sprintf "%s.svg" q.alignment_descr ]
+      (Pipeline.alignment_plot q)
   in
-  List.concat_map detection_methods ~f:foreach_detection_method
+  List.concat [
+    List.map detection_methods ~f:foreach_detection_method ;
+    List.map (Dataset.queries d) ~f:foreach_query ;
+  ]
 
 let main
     ~tree_file ~alignment_dir ~convergent_species_file