Gitlab is now running v13.9.0 - More info -> here <-

Commit 4b01833c authored by Philippe Veber's avatar Philippe Veber

Run: generate alignment plots and link to them

parent 902daf92
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment