Coloring tips by genus with interpolated colors for internal edges (versión español)

Recientemente alguien me escribió:

“Estoy tratando de colorear un árbol filogenético de manera que cumple con lo siguiente: 1. Las ramas que corresponden a los "tips” del árbol que pertenecen a un mismo género queden de un mismo color. 2. A medida que el nodo se aleja del “tip”, el color de la rama se parece cada vez más al nodo raíz. Estuve mirando bastante, y hasta hoy no encontré ninguna función que haga eso. Existe alguna en phytools que lo haga?“

La respuesta básica es que en R tenemos mucha flexibilidad para colorear las ramas de un árbol visualizado - incluso utilizando diferentes colores, colores arbitrarios, y gradientes de color.

En este caso en particular, imagino que la idea es de colorear los fines de las ramas de cada género con color distinto, y de interpolar los colores entre clados como los colores intermedios formados por un gradiente.

Aunque puedo imaginar realizar este ejercicio en una variedad de diferentes maneras, posiblemente el procedimiento más sencillo sería de utilizar la función phytools contMap.

Lo que voy a intentar a hacer, entonces, es de primero especificar el 'carácter' continuo en la forma de un número entero distinto por cada género. Después, calcularé el objeto "contMap". Finalmente, cambiaré los colores del objeto utilizando una paleta costumbre e interpolando, entonces, los colores intermedios entre clados y hacia el raíz global.

Por ejemplo, si imaginamos el siguiente árbol filogenético:

library(phytools)
tree

## 
## Phylogenetic tree with 35 tips and 34 internal nodes.
## 
## Tip labels:
##  Abc_hzfwun, Abc_pxyrhf, Abc_hdwomc, Abc_ptwcre, Bcd_ruyxcl, Bcd_utycgm, ...
## 
## Rooted; includes branch lengths.

Empezamos por identificar los diferentes géneros que tiene sobre la suposición que los nombres de los géneros están separados de los epítetos específicos por el carácter "_":

genera<-sapply(strsplit(tree$tip.label,"_"),function(x) x[1])
genera<-unique(genera)

Después, asignamos números enteros distintos por cada género:

x<-setNames(vector(length=length(tree$tip.label),mode="numeric"),
    tree$tip.label)
for(i in 1:length(genera)){
    ii<-grep(genera[i],tree$tip.label)
    x[ii]<-i
}
x

## Abc_hzfwun Abc_pxyrhf Abc_hdwomc Abc_ptwcre Bcd_ruyxcl Bcd_utycgm 
##          1          1          1          1          2          2 
## Bcd_qtpzdh Bcd_hztnqm Cde_qkubpj Def_rpgleu Def_cltzug Def_xnocve 
##          2          2          3          4          4          4 
## Def_xbcslt Efg_rinyzo Efg_dbimef Fgh_hpgwvm Fgh_plenhv Fgh_nftrld 
##          4          5          5          6          6          6 
## Fgh_nuztqh Ghi_wmbtoa Ghi_tlcuyh Ghi_giqxyw Hij_pyngrx Ijk_zxtdlf 
##          6          7          7          7          8          9 
## Ijk_fpbywq Ijk_ayfmvr Lmn_zkuxnh Mno_kbgcet Mno_vtjnfp Mno_fpjhlx 
##          9          9         10         11         11         11 
## Nop_pulhvm Nop_abdkne Nop_chnwzo Nop_xytkzn Nop_afnkjr 
##         12         12         12         12         12

Calculamos nuestro objeto "contMap":

obj<-contMap(tree,x,plot=FALSE)
obj

## Object of class "contMap" containing:
## 
## (1) A phylogenetic tree with 35 tips and 34 internal nodes.
## 
## (2) A mapped continuous trait on the range (1, 12).

Finalmente, especificamos una paleta costumbre, interpolando, entonces, los valores por el 'rasgo' imaginario entre géneros:

library(RColorBrewer)
colors<-setNames(brewer.pal(length(genera),"Set3"),genera)
colors

##       Abc       Bcd       Cde       Def       Efg       Fgh       Ghi 
## "#8DD3C7" "#FFFFB3" "#BEBADA" "#FB8072" "#80B1D3" "#FDB462" "#B3DE69" 
##       Hij       Ijk       Lmn       Mno       Nop 
## "#FCCDE5" "#D9D9D9" "#BC80BD" "#CCEBC5" "#FFED6F"

obj<-setMap(obj,colors)
plot(obj,legend=FALSE,ylim=c(-2,Ntip(obj$tree)),fsize=0.9,lwd=6)
add.simmap.legend(colors=colors[1:6],vertical=FALSE,prompt=FALSE,x=0,y=0,fsize=0.8)
add.simmap.legend(colors=colors[7:12],vertical=FALSE,prompt=FALSE,x=0,y=-1.5,fsize=0.8)

Ya.

El problema visual que tenemos en este caso en particular es que los colores interpolados no son naturales y no tienen mucho sentido en el contexto de los géneros mapeados. No tengo ninguna solución sencilla por esto en este momento. Además, el número máximo de colores disponibles en esta paleta es 12. Hay otras opciones, pero tienen sus propias limitaciones. Por ejemplo:

colors<-setNames(brewer.pal(length(genera),"Paired"),genera)
colors

##       Abc       Bcd       Cde       Def       Efg       Fgh       Ghi 
## "#A6CEE3" "#1F78B4" "#B2DF8A" "#33A02C" "#FB9A99" "#E31A1C" "#FDBF6F" 
##       Hij       Ijk       Lmn       Mno       Nop 
## "#FF7F00" "#CAB2D6" "#6A3D9A" "#FFFF99" "#B15928"

obj<-setMap(obj,colors)
plot(obj,legend=FALSE,ylim=c(-2,Ntip(obj$tree)),fsize=0.9,lwd=6)
add.simmap.legend(colors=colors[1:6],vertical=FALSE,prompt=FALSE,x=0,y=0,fsize=0.8)
add.simmap.legend(colors=colors[7:12],vertical=FALSE,prompt=FALSE,x=0,y=-1.5,fsize=0.8)

Por casualidad, la filogenia y los datos de este ejemplo fueron simulados así:

genus.tree<-pbtree(n=12,tip.label=c("Abc","Bcd","Cde","Def","Efg","Fgh","Ghi","Hij",
    "Ijk","Lmn","Mno","Nop"))
genus.tree<-phytools:::lambdaTree(genus.tree,0.7)
tips<-c()
for(i in 1:Ntip(genus.tree)){
    n.genus<-sample(1:5,1)
    for(j in 1:n.genus) tips<-c(tips,paste(genus.tree$tip.label[i],paste(sample(letters,6),collapse=""),sep="_"))
}
## these are the tips we want for our species tree:
tips
tree<-genus.to.species.tree(genus.tree,tips)
tree<-untangle(tree,"read.tree")