Docker-in-Docker (DinD) capabilities of public runners deactivated. More info

Commit 845bdfdf authored by Philippe Veber's avatar Philippe Veber
Browse files

toolbox/Candidate_site: collapsed tree representation

parent ea7e0019
open Core_kernel
open Phylogenetics
type tree = (unit, string * char * bool, float) Tree.t
type t = {
alignment_id : string ;
pos : int ;
contents : (unit, string * char * bool, float) Tree.t ;
contents : tree ;
score : float ;
}
let aa_counts s =
let leaves =
Tree.leaves s.contents
|> List.filter_map ~f:(fun (_, aa, cond) ->
match Amino_acid.of_char aa with
| Some aa -> Some (Amino_acid.to_int aa, cond)
| None -> (
match aa with
| '-' -> None
| _ -> invalid_arg "not an AA"
)
)
in
let f sel =
module Leaf_data = struct
let aa_counts leaf_data =
let leaves =
leaf_data
|> List.filter_map ~f:(fun (_, aa, _) ->
match Amino_acid.of_char aa with
| Some aa -> Some (Amino_acid.to_int aa)
| None -> (
match aa with
| '-' -> None
| _ -> invalid_arg "not an AA"
)
)
in
let r = Array.create ~len:Amino_acid.card 0 in
List.iter leaves ~f:(fun (aa, cond) ->
if Bool.(cond = sel) then r.(aa) <- r.(aa) + 1
List.iter leaves ~f:(fun aa ->
r.(aa) <- r.(aa) + 1
) ;
r
in
f false, f true
end
let aa_counts s =
let data = Tree.leaves s.contents in
let data_cond0, data_cond1 = List.partition_tf data ~f:trd3 in
Leaf_data.aa_counts data_cond0,
Leaf_data.aa_counts data_cond1
let profile_of_counts k =
let sum = float (Array.fold k ~init:0 ~f:( + )) in
......@@ -42,3 +49,66 @@ let mean_profile s =
let profiles s =
let k1, k2 = aa_counts s in
profile_of_counts k1, profile_of_counts k2
let tree_add_cond_at_leaves (t : _ Tree.t) =
let open Tree in
let rec tree = function
| Leaf (id, aa, c) -> Some c, (Leaf (id, aa, c))
| Node n ->
let List1.Cons (h, t) = List1.map n.branches ~f:branch in
let cond = List.fold t ~init:(fst h) ~f:(fun acc (maybe_cond, _) ->
match acc, maybe_cond with
| None, _
| _, None -> None
| Some c1, Some c2 ->
if Bool.(c1 = c2) then acc else None
)
in
cond, Tree.node cond (List1.cons (snd h) (List.map t ~f:snd))
and branch (Branch b) =
let cond, tip = tree b.tip in
cond, Tree.branch b.data tip
in
snd (tree t)
let collapsed_tree ~f t =
let open Tree in
let rec tree = function
| Leaf l -> Leaf (f [ l ])
| Node n ->
match n.data with
| Some _ -> Leaf (f (Tree.leaves t))
| None ->
let children = List1.map n.branches ~f:branch in
Tree.node () children
and branch (Branch b) = Tree.branch b.data (tree b.tip) in
tree (tree_add_cond_at_leaves t)
let draw_profile ~col xs =
let open Biotk_croquis.Croquis in
let n = Array.length xs in
List.init n ~f:(fun i ->
Picture.rect ~fill:col ~xmin:0. ~xmax:1. ~ymin:0. ~ymax:(2. *. xs.(i)) ()
)
|> Picture.hstack ~align:`bottom
let draw s =
let open Biotk_croquis.Croquis in
let f = function
| [] -> assert false
| (_, _, cond) :: _ as data ->
cond,
Leaf_data.aa_counts data |> profile_of_counts
in
let tree = collapsed_tree ~f s.contents in
let profiles = Tree.leaves tree in
List.map profiles ~f:(fun (cond, profile) ->
let col = if cond then Gg.Color.blue else Gg.Color.red in
Picture.blend [
draw_profile ~col profile ;
Picture.rect
~xmin:(-. 0.1) ~xmax:(float (Array.length profile) +. 0.1)
~ymin:(-0.1) ~ymax:2. () ;
]
)
|> Picture.vstack ~align:`left
open Phylogenetics
type tree = (unit, string * char * bool, float) Tree.t
type t = {
alignment_id : string ;
pos : int ;
contents : (unit, string * char * bool, float) Tree.t ;
contents : tree ;
score : float ;
}
val aa_counts : t -> int array * int array
val mean_profile : t -> float array
val profiles : t -> float array * float array
val collapsed_tree :
f:((string * char * bool) list -> 'a) ->
tree ->
(unit, 'a, float) Tree.t
val draw : t -> Biotk_croquis.Croquis.Picture.t
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