Friday, May 12, 2017

More on mapping different genera with different colors (versión español)

En respuesta a la solución para colorear los miembros de cada género en un árbol que puse el otro día en este blog, el preguntador original me comentó:

“Es bastante cercano a lo que necesito. Sin embargo, me quedan dos dudas. 1. Se podría considerar que son rasgos discretos en lugar de continuos? 2. Se podría recuperar el color asignado en cada nodo del árbol?”

La solución que puse anteriormente a mí me pareció bastante elegante, aunque con ciertas fallas. Por ejemplo, a veces la interpolación de colores entre clados resultó en unos cambios de colores entre y dentro de géneros del árbol bastante extraños.

Por consiguiente, identifique otra solución completamente distinta. La idea con esta solución es de mapear la historia completa de cada clado sobre el árbol, con ramas compartidas entre género (básicamente, ramas que tienen en común dos o más géneros en sus historias completas respectivas desde el raíz global hacia el presente) coloreadas con colores semitransparentes, resultando en la percepción de colores intermedios sobre las ramas conectando géneros distintos.

Por ejemplo:

library(phytools)
library(RColorBrewer)
library(phangorn)
tree
## 
## Phylogenetic tree with 35 tips and 34 internal nodes.
## 
## Tip labels:
##  Abc_wzsgrx, Abc_xwezmb, Abc_bmdyhc, Abc_vblodn, Bcd_disnjy, Bcd_kpgdrq, ...
## 
## Rooted; includes branch lengths.
genera<-sapply(strsplit(tree$tip.label,"_"),function(x) x[1])
GENERA<-unique(genera)
colors<-setNames(brewer.pal(length(GENERA),"Paired"),GENERA)
plotTree(tree,color="transparent",ftype="i")
xlim<-get("last_plot.phylo", envir = .PlotPhyloEnv)$x.lim
for(i in 1:length(GENERA)){
    MRCA<-findMRCA(tree,tree$tip.label[grep(GENERA[i],tree$tip.label)])
    if(!is.null(MRCA)) TREE<-paintSubTree(tree,MRCA,"2","1",stem=TRUE)
    else TREE<-paintSubTree(tree,MRCA<-which(genera==GENERA[i]),
        "2","1",stem=TRUE)
    aa<-Ancestors(tree,MRCA,"all")
    cols<-c("transparent",colors[GENERA[i]])
    if(length(aa)>1){
        aa<-aa[1:(length(aa)-1)]
        for(i in 1:length(aa)){
            TREE<-paintBranches(TREE,aa[i],i+2)
            dd<-getDescendants(tree,aa[i])
            ng<-length(unique(genera[dd[dd<=Ntip(tree)]]))
            cols[i+2]<-make.transparent(cols[2],1/ng)
        }
    }
    cols<-setNames(cols,1:length(cols))
    plot(TREE,cols,add=TRUE,split.vertical=TRUE,ftype="off",xlim=xlim,
        lwd=6)
}

plot of chunk unnamed-chunk-1

Para mejor visualizar la manera en que estamos realizando este efecto, podemos “pausar” (y en efecto animar) el proceso de graficar, paso por paso, las historias distintas de nuestros géneros. El resultado tuve que capturar en la forma de un video:

Extraer los colores en los nodos o sobre las ramas interiores sería otra cosa todavía. Los colores dentro de cada clado son fijos, pero los colores sobre las ramas interiores corresponden no a colores particulares conocidos por R pero de una mezcla de colores resultando por el efecto de pintar un color semitransparente sobre otros.

1 comment:

  1. Hi, Liam, I have been try do that with my phylogeny but it does appear a warning message:

    "Error in setNames(brewer.pal(length(GENERA), "Paired"), GENERA) :
    'names' attribute [125] must be the same length as the vector [12]
    In addition: Warning message:
    In brewer.pal(length(GENERA), "Paired") :
    n too large, allowed maximum for palette Paired is 12
    Returning the palette you asked for with that many colors"

    Can I do something about it?

    ReplyDelete

Note: due to the very large amount of spam, all comments are now automatically submitted for moderation.