Commit 527fa3c3 authored by Philippe Veber's avatar Philippe Veber
Browse files

tk/Convergence_tree: added to_newick_tree

parent 94f0f0e6
......@@ -18,6 +18,10 @@ module Tags = struct
let condition tags =
List.Assoc.find tags condition_label ~equal:String.equal
let string_of_condition = function
| `Ancestral -> "0"
| `Convergent -> "1"
let set_condition tags c =
List.Assoc.(
add
......@@ -68,6 +72,16 @@ let of_newick_tree t =
|> Result.return
with Failure msg -> Result.fail (`Msg msg)
let to_newick_tree t =
let node () = { Newick.name = None } in
let leaf l = { Newick.name = Some l } in
let branch b = {
Newick.length = Some b.length ;
tags = []
}
in
Tree.map t ~node ~leaf ~branch
let from_file fn =
let module BI = Phylogenetics_convergence.Simulator.Branch_info in
Newick.from_file fn
......@@ -84,7 +98,7 @@ let leaves tree =
node `Ancestral tree []
let rec transfer_condition_to_branches t =
let category : _ Tree.t -> int = function
let category : _ Tree.t -> condition = function
| Leaf (_, c) -> c
| Node n -> snd n.data
in
......@@ -94,7 +108,7 @@ let rec transfer_condition_to_branches t =
List1.map n.branches ~f:(fun (Branch b) ->
let cat_child = category b.tip in
let tags =
Tags.set_condition b.data.Newick.tags (Int.to_string cat_child)
Tags.set_condition b.data.Newick.tags (Tags.string_of_condition cat_child)
in
Tree.branch
{ b.data with Newick.tags }
......@@ -177,5 +191,11 @@ let infer_binary_condition_on_branches ?(gain_relative_cost = 2.) t
| 0, 0 | 1, 1 -> 0.
| _ -> assert false
in
let convert_node = function
| x, 0 -> x, `Ancestral
| x, 1 -> x, `Convergent
| _ -> assert false
in
Fitch.fitch ~cost ~n:2 ~category t
|> Tree.map ~node:convert_node ~leaf:convert_node ~branch:Fn.id
|> transfer_condition_to_branches |> reset_transitions
......@@ -12,6 +12,8 @@ type t = (unit, string, branch_info) Tree.t
val of_newick_tree : Newick.tree -> (t, [> `Msg of string]) result
val to_newick_tree : t -> Newick.tree
val from_file : string -> (t, [> `Msg of string]) result
val leaves : t -> (string * condition) list
......
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