Commit 12017b70 authored by Philippe Veber's avatar Philippe Veber
Browse files

update wrt phylogenetics

parent 98192f3b
...@@ -63,7 +63,7 @@ module New_API = struct ...@@ -63,7 +63,7 @@ module New_API = struct
let clip_tree_on_alignment (tree : nhx file) (ali : nucleotide_fasta file) = let clip_tree_on_alignment (tree : nhx file) (ali : nucleotide_fasta file) =
let f = fun%workflow dest -> let f = fun%workflow dest ->
let open Phylogenetics in let open Phylogenetics in
let tree = Newick.from_file [%path tree] in let tree = Newick.from_file_exn [%path tree] in
let _, ali = let _, ali =
Biotk.Fasta.from_file [%path ali] Biotk.Fasta.from_file [%path ali]
|> Result.ok_or_failwith |> Result.ok_or_failwith
...@@ -89,7 +89,7 @@ module New_API = struct ...@@ -89,7 +89,7 @@ module New_API = struct
let species = [%eval species] let species = [%eval species]
and omm_tree = [%path tree] in and omm_tree = [%path tree] in
let ensembl_tree = Newick.from_file omm_tree in let ensembl_tree = Newick.from_file_exn omm_tree in
let tagged_tree = let tagged_tree =
Newick.map_inner_tree ensembl_tree ~f:(fun t -> Newick.map_inner_tree ensembl_tree ~f:(fun t ->
Codepitk.Convergence_tree.infer_binary_condition_on_branches Codepitk.Convergence_tree.infer_binary_condition_on_branches
......
...@@ -102,7 +102,7 @@ module Make (Q : Query) = struct ...@@ -102,7 +102,7 @@ module Make (Q : Query) = struct
let f = fun%workflow dest -> let f = fun%workflow dest ->
let tree_file = [%path tree ~branch_length_unit d] in let tree_file = [%path tree ~branch_length_unit d] in
let open Phylogenetics in let open Phylogenetics in
let tree = Newick.from_file tree_file in let tree = Newick.from_file_exn tree_file in
let tree = let tree =
Newick.map_inner_tree tree Newick.map_inner_tree tree
~f: ~f:
...@@ -263,7 +263,7 @@ module Make (Q : Query) = struct ...@@ -263,7 +263,7 @@ module Make (Q : Query) = struct
let condition s = let condition s =
if List.mem s convergent_species then `Convergent else `Ancestral if List.mem s convergent_species then `Convergent else `Ancestral
in in
let tree = Phylogenetics.Newick.from_file tree_path in let tree = Phylogenetics.Newick.from_file_exn tree_path in
let alignment = let alignment =
Biotk.Fasta.from_file alignment_path Biotk.Fasta.from_file alignment_path
|> Base.Result.ok_or_failwith |> snd |> Base.Result.ok_or_failwith |> snd
...@@ -295,7 +295,7 @@ module Make (Q : Query) = struct ...@@ -295,7 +295,7 @@ module Make (Q : Query) = struct
let module Result_table = Codepitk.Result_table in let module Result_table = Codepitk.Result_table in
let lazy_load xs ~f = List.map xs ~f:(fun x -> lazy (f x)) |> Array.of_list in let lazy_load xs ~f = List.map xs ~f:(fun x -> lazy (f x)) |> Array.of_list in
let results = lazy_load result_files ~f:Result_table.of_file in let results = lazy_load result_files ~f:Result_table.of_file in
let trees = lazy_load trees ~f:Phylogenetics.Newick.from_file in let trees = lazy_load trees ~f:Phylogenetics.Newick.from_file_exn in
let alignments = lazy_load alignments ~f:Biotk.Fasta.from_file in let alignments = lazy_load alignments ~f:Biotk.Fasta.from_file in
let module S = struct let module S = struct
type t = { type t = {
......
...@@ -66,7 +66,7 @@ let clip_tree_on_alignment ?(handle_tags = true) (tree:(#newick as 'a) file) (al ...@@ -66,7 +66,7 @@ let clip_tree_on_alignment ?(handle_tags = true) (tree:(#newick as 'a) file) (al
let f = fun%workflow dest -> let f = fun%workflow dest ->
let open Phylogenetics in let open Phylogenetics in
let handle_tags = [%param handle_tags] in let handle_tags = [%param handle_tags] in
let tree = Newick.from_file [%path tree] in let tree = Newick.from_file_exn [%path tree] in
let ali = Phylip.read_exn ~strict:false [%path ali] in let ali = Phylip.read_exn ~strict:false [%path ali] in
let ali_species = List.map ali.items ~f:(fun it -> it.name) in let ali_species = List.map ali.items ~f:(fun it -> it.name) in
let remove_nodes_with_single_child = let remove_nodes_with_single_child =
...@@ -104,8 +104,8 @@ let omm_tree_of_db db = ...@@ -104,8 +104,8 @@ let omm_tree_of_db db =
let compare_tree_branch_lengths t1 t2 = let compare_tree_branch_lengths t1 t2 =
let f = fun%workflow dest -> let f = fun%workflow dest ->
let open Phylogenetics in let open Phylogenetics in
let t1 = Newick.from_file [%path t1] in let t1 = Newick.from_file_exn [%path t1] in
let t2 = Newick.from_file [%path t2] in let t2 = Newick.from_file_exn [%path t2] in
let rec reorder_branches (branches : _ Tree.branch List1.t) = let rec reorder_branches (branches : _ Tree.branch List1.t) =
List1.map branches ~f:(fun (Branch b) -> List1.map branches ~f:(fun (Branch b) ->
let tip, label = reorder_tree_aux b.tip in let tip, label = reorder_tree_aux b.tip in
...@@ -266,7 +266,7 @@ let concatenate_calibration_figure ~nsites ~trees = ...@@ -266,7 +266,7 @@ let concatenate_calibration_figure ~nsites ~trees =
let tree_lengths = let tree_lengths =
List.map tree_paths ~f:( List.map tree_paths ~f:(
List.map ~f:(fun tree_path -> List.map ~f:(fun tree_path ->
Newick.from_file tree_path Newick.from_file_exn tree_path
|> Newick.with_inner_tree ~f:( |> Newick.with_inner_tree ~f:(
Tree.prefix_traversal ~init:0. Tree.prefix_traversal ~init:0.
~node:(fun acc _ -> acc) ~leaf:(fun acc _ -> acc) ~node:(fun acc _ -> acc) ~leaf:(fun acc _ -> acc)
...@@ -484,7 +484,7 @@ let convergence_species_tree_pdf ~convergent_species db = ...@@ -484,7 +484,7 @@ let convergence_species_tree_pdf ~convergent_species db =
| Branch b -> P.draw_branch (of_branch b) | Branch b -> P.draw_branch (of_branch b)
in in
let tree_or_branch = let tree_or_branch =
Newick.from_file tree_path Newick.from_file_exn tree_path
|> Newick.map_inner_tree ~f:(fun t -> |> Newick.map_inner_tree ~f:(fun t ->
Codepitk.Convergence_tree.infer_binary_condition_on_branches Codepitk.Convergence_tree.infer_binary_condition_on_branches
t ~convergent_leaves:convergent_species) t ~convergent_leaves:convergent_species)
...@@ -509,7 +509,7 @@ let ranking_of_results ~alignment_ids ~convergent_species (alignments : aminoaci ...@@ -509,7 +509,7 @@ let ranking_of_results ~alignment_ids ~convergent_species (alignments : aminoaci
let module Result_table = Codepitk.Result_table in let module Result_table = Codepitk.Result_table in
let lazy_load xs ~f = List.map xs ~f:(fun x -> lazy (f x)) |> Array.of_list in let lazy_load xs ~f = List.map xs ~f:(fun x -> lazy (f x)) |> Array.of_list in
let results = lazy_load result_files ~f:Result_table.of_file in let results = lazy_load result_files ~f:Result_table.of_file in
let trees = lazy_load trees ~f:Phylogenetics.Newick.from_file in let trees = lazy_load trees ~f:Phylogenetics.Newick.from_file_exn in
let alignments = lazy_load alignments ~f:Biotk.Fasta.from_file in let alignments = lazy_load alignments ~f:Biotk.Fasta.from_file in
let module S = struct let module S = struct
type t = { type t = {
...@@ -601,7 +601,7 @@ let draw_site q pos = ...@@ -601,7 +601,7 @@ let draw_site q pos =
let pos = [%param pos] in let pos = [%param pos] in
let open Codepitk in let open Codepitk in
let open Biotk_croquis in let open Biotk_croquis in
let tree = Phylogenetics.Newick.from_file tree_fn in let tree = Phylogenetics.Newick.from_file_exn tree_fn in
let condition n = let condition n =
if List.mem convergent_species n ~equal:String.equal if List.mem convergent_species n ~equal:String.equal
then `Convergent then `Convergent
......
...@@ -166,8 +166,8 @@ let match_species_tree_position ~gene_tree ~clipped_species_tree = ...@@ -166,8 +166,8 @@ let match_species_tree_position ~gene_tree ~clipped_species_tree =
let f = let f =
[%workflow [%workflow
fun dest -> fun dest ->
let master_tree = Newick.from_file [%path clipped_species_tree] in let master_tree = Newick.from_file_exn [%path clipped_species_tree] in
let gene_tree = Newick.from_file [%path gene_tree] in let gene_tree = Newick.from_file_exn [%path gene_tree] in
let rearranged_gene_tree = let rearranged_gene_tree =
Newick.map_inner_tree master_tree ~f:(fun master_tree -> Newick.map_inner_tree master_tree ~f:(fun master_tree ->
Newick.with_inner_tree gene_tree ~f:(fun gene_tree -> Newick.with_inner_tree gene_tree ~f:(fun gene_tree ->
...@@ -254,4 +254,4 @@ module Candidate = struct ...@@ -254,4 +254,4 @@ module Candidate = struct
| Error msg -> failwith msg | Error msg -> failwith msg
in Workflow.plugin ~descr:"RER.load_best_candidates" f in Workflow.plugin ~descr:"RER.load_best_candidates" f
end end
\ No newline at end of file
...@@ -49,7 +49,7 @@ module Query = struct ...@@ -49,7 +49,7 @@ module Query = struct
convergent_species q convergent_species q
|> String.Set.of_list |> String.Set.of_list
in in
Newick.from_file (nhx_path q) Newick.from_file_exn (nhx_path q)
|> Newick.map_inner_tree ~f:(fun tree -> |> Newick.map_inner_tree ~f:(fun tree ->
Tk.Convergence_tree.infer_binary_condition_on_branches tree ~convergent_leaves Tk.Convergence_tree.infer_binary_condition_on_branches tree ~convergent_leaves
|> Tk.Convergence_tree.reset_transitions |> Tk.Convergence_tree.reset_transitions
......
...@@ -89,7 +89,7 @@ let to_newick_tree t = ...@@ -89,7 +89,7 @@ let to_newick_tree t =
Tree.map t ~node ~leaf ~branch Tree.map t ~node ~leaf ~branch
let from_file fn = let from_file fn =
Newick.from_file fn Newick.from_file_exn fn
|> Newick.with_inner_tree ~f:of_newick_tree |> Newick.with_inner_tree ~f:of_newick_tree
let leaves tree = let leaves tree =
......
...@@ -3,7 +3,7 @@ open Phylogenetics ...@@ -3,7 +3,7 @@ open Phylogenetics
let write_phenotypes ~newick ~output = let write_phenotypes ~newick ~output =
Out_channel.with_file output ~f:(fun oc -> Out_channel.with_file output ~f:(fun oc ->
Newick.from_file newick Newick.from_file_exn newick
|> Newick.with_inner_tree ~f:(fun tree -> |> Newick.with_inner_tree ~f:(fun tree ->
Tree.leaves tree Tree.leaves tree
|> List.iter ~f:(fun leaf -> |> List.iter ~f:(fun leaf ->
......
...@@ -175,8 +175,8 @@ let demo seq_length ~rate_CpG ~branch_length = ...@@ -175,8 +175,8 @@ let demo seq_length ~rate_CpG ~branch_length =
let param = Evolution_model.random_param ~alpha_nuc:0.5 ~alpha_fitness:0.5 ~rate_CpG in let param = Evolution_model.random_param ~alpha_nuc:0.5 ~alpha_fitness:0.5 ~rate_CpG in
let tree = let tree =
sprintf "(leaf:%f);" branch_length sprintf "(leaf:%f);" branch_length
|>Newick.from_string |> Newick.from_string_exn
|>Newick.with_inner_tree ~f:(fun tree -> |> Newick.with_inner_tree ~f:(fun tree ->
M.sequence_gillespie_direct tree ~root:root_sequence ~param M.sequence_gillespie_direct tree ~root:root_sequence ~param
) )
in in
......
...@@ -3,7 +3,7 @@ open Core_kernel ...@@ -3,7 +3,7 @@ open Core_kernel
let tree_from_file ?(alpha = 1.) fn = let tree_from_file ?(alpha = 1.) fn =
let open Phylogenetics in let open Phylogenetics in
let module BI = Convergence_tree.Branch_info in let module BI = Convergence_tree.Branch_info in
Newick.from_file fn Newick.from_file_exn fn
|> Newick.with_inner_tree ~f:(fun t -> |> Newick.with_inner_tree ~f:(fun t ->
Tree.map t ~node:Fn.id ~leaf:Fn.id ~branch:Phylogenetics.Newick.(fun b -> Tree.map t ~node:Fn.id ~leaf:Fn.id ~branch:Phylogenetics.Newick.(fun b ->
let length = Option.value_exn b.length *. alpha in let length = Option.value_exn b.length *. alpha in
......
...@@ -155,7 +155,7 @@ let newick_of_nhx (t : nhx file) : newick file = ...@@ -155,7 +155,7 @@ let newick_of_nhx (t : nhx file) : newick file =
let f = fun%workflow dest -> let f = fun%workflow dest ->
let tree_file = [%path t] in let tree_file = [%path t] in
let open Phylogenetics in let open Phylogenetics in
let tree = Newick.from_file tree_file in let tree = Newick.from_file_exn tree_file in
let tree = Newick.map_inner_tree tree ~f:(Tree.map ~leaf:Fn.id ~node:Fn.id ~branch:(fun bi -> { bi with Newick.tags = [] })) in let tree = Newick.map_inner_tree tree ~f:(Tree.map ~leaf:Fn.id ~node:Fn.id ~branch:(fun bi -> { bi with Newick.tags = [] })) in
Newick.to_file tree dest Newick.to_file tree dest
in in
......
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