Colorized OTU based on their phylogenetic proximity

An elegant method to colorized points based on the phylogenetic proximity is presented in this paper:
Lespinats, S., Fertil, B., 2011. ColorPhylo: A color code to accurately display taxonomic classifications. Evol Bioinform Online 7, 257-270.

However, only matlab code is provided.

Here I provide R code of an enhanced version of this algorithm.




library(ape)
data(bird.orders)
plot(bird.orders)




Now let calculate the colors for each OTU (here the orders) to reflect their phylogenetic proximities. The results are in a data.frame with one column with the OTU name and one column with the rgb() color:

dn <- cophenetic(bird.orders)
library(MASS)
dimension.color <- 3
rgb <- isoMDS(d=dn, k=dimension.color)
rgb.OTU <- rgb$points
r <- apply(rgb.OTU, MARGIN=2, FUN="range")
for (col in 1:dimension.color)
rgb.OTU[, col] <- (rgb.OTU[, col]-r[1,col])/(r[2, col]-r[1, col])
OTUColor <- data.frame(OTU=rownames(rgb.OTU), color=rgb(red=rgb.OTU[, 1], green=rgb.OTU[, 2], blue=rgb.OTU[, 3]), stringsAsFactors = FALSE)

And here are the results:

plot(x=1:(dim(OTUColor)[1]), y=1:(dim(OTUColor)[1]), type="n", axes=FALSE, xlab="", ylab="")
for (lgn in 1:(dim(OTUColor)[1]))
text(x=(dim(OTUColor)[1])/2, y=lgn, labels = OTUColor[lgn, "OTU"], col=OTUColor[lgn, "color"])

And now the phylogeny:

par(mar=c(1, 4, 1, 1))
plot(bird.orders, tip.color=OTUColor[match(bird.orders$tip.label, OTUColor$OTU), "color"])



You can of course combine this method with all the various ways to plot dendrogram shown here:

For example:

hc = hclust(dist(mtcars))

library(ape)
phylo_hc <- as.phylo(hc)
dn <- cophenetic(phylo_hc)

library(MASS)
dimension.color <- 3
rgb <- isoMDS(d=dn, k=dimension.color)
rgb.OTU <- rgb$points
r <- apply(rgb.OTU, MARGIN=2, FUN="range")
for (col in 1:dimension.color)
  rgb.OTU[, col] <- (rgb.OTU[, col]-r[1,col])/(r[2, col]-r[1, col])

# order of colors=1, 2, or 3
red <- 1
green <- 2
blue <- 3

OTUColor <- data.frame(OTU=rownames(rgb.OTU), 
                       color=rgb(red=rgb.OTU[, red], green=rgb.OTU[, green], blue=rgb.OTU[, blue]), stringsAsFactors = FALSE)

colLab <- function(n) {
  if (is.leaf(n)) {
    a <- attributes(n)
    labCol <- OTUColor[which(OTUColor[, "OTU"] == a$label), "color"]
    attr(n, "nodePar") <- c(a$nodePar, lab.col = labCol)
  }
  n
}

hcd = as.dendrogram(hc)
clusDendro = dendrapply(hcd, colLab)
# make plot
plot(clusDendro, main = "Cool Dendrogram", type = "triangle")



# Note the difference when order of colors is changed

red <- 3
green <- 2
blue <- 1

OTUColor <- data.frame(OTU=rownames(rgb.OTU), 
                       color=rgb(red=rgb.OTU[, red], green=rgb.OTU[, green], blue=rgb.OTU[, blue]), stringsAsFactors = FALSE)

clusDendro = dendrapply(hcd, colLab)
# make plot
plot(clusDendro, main = "Cool Dendrogram", type = "triangle")



Commentaires

Posts les plus consultés de ce blog

Standard error from Hessian Matrix... what can be done when problem occurs

stepAIC from package MASS with AICc

Install treemix in ubuntu 20.04