Projecting a continuous character onto the branches of multiple trees using a consistent color gradient with contMap

A phytools user recently contacted me about using phytools::contMap with a constant color gradient across trees.

This can easily be done using the optional argument lims (although they said they tried this, so there might be some other problem).

Nonetheless, here’s a quick demo.

## load phytools
library(phytools)

## load a phylogeny from Garland et al. (1992)
data(mammal.tree)
plotTree(mammal.tree,direction="upwards",fsize=0.7,
  ftype="i")
nodelabels()

Now let’s pull out clades corresponding to Carnivora, Perrisodactyla, and Artiodactyla, as follows.

carnivora<-extract.clade(mammal.tree,51)
perrisodactyla<-extract.clade(mammal.tree,70)
artiodactyla<-extract.clade(mammal.tree,75)
par(mfrow=c(1,3))
plotTree(carnivora,ftype="i")
plotTree(perrisodactyla,ftype="i")
plotTree(artiodactyla,ftype="i")

Next, let’s get our data.

## load data
data(mammal.data)
head(mammal.data)

##               bodyMass homeRange
## U._maritimus     265.0    115.60
## U._arctos        251.3     82.80
## U._americanus     93.4     56.80
## N._narica          4.4      1.05
## P._lotor           7.0      1.14
## M._mephitis        2.5      2.50

Obviously, body size is a trait that will have very different distributions across these three different groups.

lnBodyMass<-setNames(log(mammal.data$bodyMass),
  rownames(mammal.data))
head(lnBodyMass)

##  U._maritimus     U._arctos U._americanus     N._narica      P._lotor   M._mephitis 
##     5.5797298     5.5266474     4.5368913     1.4816045     1.9459101     0.9162907

Now let’s make a single contMap plot for all of mammals (at least those in this tree).

mammals_cMap<-contMap(mammal.tree,lnBodyMass,
  plot=FALSE)
mammals_cMap<-setMap(mammals_cMap,hcl.colors(n=100,
  palette="plasma"))
plot(mammals_cMap,direction="upwards",legend=50,fsize=0.8,
  leg.txt="log(body mass)",offset=1)

So far, so good.

Now let’s do three contMap plots for our three trees, using the default conditions.

carnivora_cMap<-contMap(carnivora,
  lnBodyMass[carnivora$tip.label],plot=FALSE)
carnivora_cMap<-setMap(carnivora_cMap,
  hcl.colors(n=100,palette="plasma"))
perrisodactyla_cMap<-contMap(perrisodactyla,
  lnBodyMass[perrisodactyla$tip.label],plot=FALSE)
perrisodactyla_cMap<-setMap(perrisodactyla_cMap,
  hcl.colors(n=100,palette="plasma"))
artiodactyla_cMap<-contMap(artiodactyla,
  lnBodyMass[artiodactyla$tip.label],plot=FALSE)
artiodactyla_cMap<-setMap(artiodactyla_cMap,
  hcl.colors(n=100,palette="plasma"))
par(mfrow=c(1,3))
plot(carnivora_cMap,leg.txt="log(body mass)",
  legend=40)
plot(perrisodactyla_cMap,leg.txt="log(body mass)",
  legend=40)
plot(artiodactyla_cMap,leg.txt="log(body mass)",
  legend=40)

There’s nothing inherently wrong about this figure, but it’s a bit misleading because our color gradient shifts for each subplot!

Let’s try it again using lims = range(lnBodyMass) to maintain a constant set of limits on our trait range.

Note that we need to do this when creating our contMap object, not just when plotting!

carnivora_cMap<-contMap(carnivora,
  lnBodyMass[carnivora$tip.label],plot=FALSE,
  lims=range(lnBodyMass))
carnivora_cMap<-setMap(carnivora_cMap,
  hcl.colors(n=100,palette="plasma"))
perrisodactyla_cMap<-contMap(perrisodactyla,
  lnBodyMass[perrisodactyla$tip.label],plot=FALSE,
  lims=range(lnBodyMass))
perrisodactyla_cMap<-setMap(perrisodactyla_cMap,
  hcl.colors(n=100,palette="plasma"))
artiodactyla_cMap<-contMap(artiodactyla,
  lnBodyMass[artiodactyla$tip.label],plot=FALSE,
  lims=range(lnBodyMass))
artiodactyla_cMap<-setMap(artiodactyla_cMap,
  hcl.colors(n=100,palette="plasma"))
par(mfrow=c(1,3))
plot(carnivora_cMap,leg.txt="log(body mass)",
  legend=40)
plot(perrisodactyla_cMap,leg.txt="log(body mass)",
  legend=40)
plot(artiodactyla_cMap,leg.txt="log(body mass)",
  legend=40)

Cool.

For one last demo, let’s plot all three of these with their own branch length legends in each subplot, but a single continuous character legend at the bottom.

## simple function to add a legend
tree_legend<-function(length,units="ma"){
  pp<-get("last_plot.phylo",envir=.PlotPhyloEnv)
  x0<-0
  y0<-mean(pp$y.lim[1],min(pp$yy))
  lines(x=c(x0,x0+length),y=rep(y0,2))
  text(x0+length/2,y0,paste(signif(length,3),units),
    pos=1)
}
layout(mat=matrix(c(1,2,3,4,4,4),2,3,byrow=TRUE),
  heights=c(0.9,0.1))
par(bg="black",fg="white")
plot(carnivora_cMap,legend=FALSE,
  ylim=c(1-0.05*Ntip(carnivora_cMap),
    Ntip(carnivora_cMap)),outline=FALSE,lwd=6)
tree_legend(40)
plot(perrisodactyla_cMap,legend=FALSE,
  ylim=c(1-0.05*Ntip(perrisodactyla_cMap),
    Ntip(perrisodactyla_cMap)),outline=FALSE,lwd=6)
tree_legend(40)
plot(artiodactyla_cMap,legend=FALSE,
  ylim=c(1-0.05*Ntip(artiodactyla_cMap),
    Ntip(artiodactyla_cMap)),outline=FALSE,lwd=6)
tree_legend(40)
plot(NA,xlim=c(0,100),ylim=c(-2,2),mar=rep(0.3,4),
  bty="n",axes=FALSE,xlab="",ylab="")
add.color.bar(80,carnivora_cMap$cols,title="log(body mass)",
  lims=carnivora_cMap$lims,digits=3,prompt=FALSE,
  x=10,y=-1,fsize=1.2,subtitle="",outline=FALSE,
  lwd=10)