Plotting an 'upward-facing' traitgram using phylomorphospace

A long-time friend & colleague just asked on Twitter:

Does anyone know of a way to have phytools::phenogram plot upwards? the 'direction=“upwards”' in plotTree won't work in this case. @phytools_liam?

— ??rcio Pie (@marciopie) June 20, 2020

You can do this in phytools, in fact, but only using phylomorphospace. Here's a demo.

First, we'll use some data from Revell & Collar (2009) that now comes packaged with phytools:

library(phytools)
data(sunfish.data)
data(sunfish.tree)
x<-setNames(sunfish.data$gape.width,
    rownames(sunfish.data))
tree<-as.phylo(sunfish.tree)
tree

## 
## Phylogenetic tree with 28 tips and 27 internal nodes.
## 
## Tip labels:
##  Acantharchus_pomotis, Lepomis_gibbosus, Lepomis_microlophus, Lepomis_punctatus, Lepomis_miniatus, Lepomis_auritus, ...
## 
## Rooted; includes branch lengths.

x

##    Acantharchus_pomotis        Lepomis_gibbosus     Lepomis_microlophus 
##                   0.114                  -0.133                  -0.151 
##       Lepomis_punctatus        Lepomis_miniatus         Lepomis_auritus 
##                  -0.103                  -0.134                  -0.222 
##      Lepomis_marginatus       Lepomis_megalotis         Lepomis_humilis 
##                  -0.187                  -0.073                   0.024 
##     Lepomis_macrochirus         Lepomis_gulosus     Lepomis_symmetricus 
##                  -0.191                   0.131                   0.013 
##       Lepomis_cyanellus      Micropterus_coosae      Micropterus_notius 
##                  -0.002                   0.045                   0.097 
##     Micropterus_treculi   Micropterus_salmoides  Micropterus_floridanus 
##                   0.056                   0.056                   0.096 
## Micropterus_punctulatus    Micropterus_dolomieu Centrarchus_macropterus 
##                   0.092                   0.035                  -0.007 
##      Enneacantus_obesus       Pomoxis_annularis  Pomoxis_nigromaculatus 
##                   0.016                  -0.004                   0.105 
##  Archolites_interruptus    Ambloplites_ariommus   Ambloplites_rupestris 
##                  -0.024                   0.135                   0.086 
##   Ambloplites_cavifrons 
##                   0.130

To create our traitgram (as the plot created by phytools::phenogram is properly called), we need to first compute the vertical and horizontal positions of our ancestral nodes:

a<-fastAnc(tree,x)
t<-sapply(1:Ntip(tree),nodeheight,tree=tree)
h<-sapply(1:tree$Nnode+Ntip(tree),nodeheight,
    tree=tree)

Now we're ready to feed these into phylomorphospace to create our plot:

par(mar=c(5.1,4.1,2.1,1.1))
phylomorphospace(tree,
    X=cbind(x[tree$tip.label],t),
    A=cbind(a,h),node.size=c(0,1),bty="l",
    label="off",xlab="relative gape width",
    ylab="time",
    ylim=c(0,1.4*max(h)))
fsize<-0.6
segments(x[tree$tip.label],t,x[tree$tip.label],
    t+0.05*max(h),lty="dotted")
text(x[tree$tip.label],t+0.05*max(h),
    gsub("_"," ",tree$tip.label),
    srt=90,pos=4,offset=0,
    cex=fsize,font=3)

Note the phylomorphospace can also plot a tree with a mapped discrete character, just like phenogram.

For fun, let's also evenly space the tip labels this time.

E.g.:

cols<-setNames(c("blue","red"),c("non","pisc"))
par(mar=c(5.1,4.1,2.1,1.1))
phylomorphospace(sunfish.tree,colors=cols,
    node.by.map=TRUE,
    X=cbind(x[sunfish.tree$tip.label],t),
    A=cbind(a,h),node.size=c(0,1),bty="l",
    label="off",xlab="relative gape width",
    ylab="time",
    ylim=c(0,1.4*max(h)))
fsize<-0.6
segments(sort(x[sunfish.tree$tip.label]),t,
    seq(min(x),max(x),length.out=Ntip(sunfish.tree)),
    t+0.05*max(h),lty="dotted")
text(seq(min(x),max(x),length.out=Ntip(sunfish.tree)),
    t+0.05*max(h),
    gsub("_"," ",names(sort(x))),
    srt=90,pos=4,offset=0,
    cex=fsize,font=3)
legend(x="bottomleft",bty="n",
    legend=c("non-piscivorous","piscivorous"),
    pch=22,pt.cex=1.5,pt.bg=cols)
points(x[sunfish.tree$tip.label],t,pch=19,cex=1.2,
    col=cols[getStates(sunfish.tree,"tips")])

Pretty cool.