Thursday, April 13, 2023

ANSI text graphic style plotted phylogeny in R

This may be the dumbest thing I’ve wasted a half-hour on, but I feel confident someone will find a way to make use of this…. Here’s a R phylogenetics plotting function that creates an ANSI text style phylogeny.

Asp<-function(){
  w<-par("pin")[1]/diff(par("usr")[1:2])
  h<-par("pin")[2]/diff(par("usr")[3:4])
  w/h
}
ansi_phylo<-function(tree,...){
  args<-list(...)
  args$direction<-"rightwards"
  args$type<-"phylogram"
  args$plot<-FALSE
  args$tree<-tree
  do.call(plotTree,args)
  pp<-get("last_plot.phylo",envir=.PlotPhyloEnv)
  par(family="mono")
  w<-strwidth("-")
  h<-strwidth("-")*Asp()
  ee<-pp$edge
  for(i in 1:nrow(pp$edge)){
    d<-diff(pp$xx[ee[i,]])
    n<-floor(d/w)
    x<-mean(pp$xx[ee[i,]])
    y<-pp$yy[ee[i,2]]
    text(x,y,paste(rep("-",n),collapse=""))
    if(ee[i,2]>Ntip(tree)) {
      dd<-ee[which(ee[,1]==ee[i,2]),2]
      d<-diff(pp$yy[dd])
      n<-floor(d/h)
      y<-mean(pp$yy[dd])
      x<-pp$xx[ee[i,2]]
      text(x,y,paste(rep("-",n),collapse=""),srt=90)
    }
  }
  root<-Ntip(tree)+1
  dd<-ee[which(ee[,1]==root),2]
  d<-diff(pp$yy[dd])
  n<-floor(d/h)
  y<-mean(pp$yy[dd])
  x<-mean(pp$xx[root])
  text(x,y,paste(rep("-",n),collapse=""),srt=90)
  if(hasArg(fsize)) fsize<-list(...)$fsize
  else fsize<-1
  for(i in 1:Ntip(tree)) text(pp$xx[i],pp$yy[i],
    tree$tip.label[i],pos=4,cex=fsize)
}

Let’s try it.

library(phytools)
data(salamanders)
ansi_phylo(salamanders)

plot of chunk unnamed-chunk-2

What?

This looks cool, but it is kind of cheating because instead of using the real vertical | in our graph, we rotated the standard -.

Let’s try again, but with the vertical bar.

ansi_phylo2<-function(tree,...){
  args<-list(...)
  args$direction<-"rightwards"
  args$type<-"phylogram"
  args$plot<-FALSE
  args$tree<-tree
  do.call(plotTree,args)
  pp<-get("last_plot.phylo",envir=.PlotPhyloEnv)
  par(family="mono")
  w<-strwidth("-")
  h<-1.4*strheight("|")
  ee<-pp$edge
  for(i in 1:nrow(pp$edge)){
    d<-diff(pp$xx[ee[i,]])
    n<-floor(d/w)
    x<-mean(pp$xx[ee[i,]])
    y<-pp$yy[ee[i,2]]
    text(x,y,paste(rep("-",n),collapse=""))
    if(ee[i,2]>Ntip(tree)) {
      dd<-ee[which(ee[,1]==ee[i,2]),2]
      d<-diff(pp$yy[dd])
      n<-floor(d/h)
      y<-seq(h/2,by=h,length.out=n)
      y<-(y-mean(y))+mean(pp$yy[dd])
      x<-rep(pp$xx[ee[i,2]],length(y))
      text(x,y,"|")
    }
  }
  root<-Ntip(tree)+1
  dd<-ee[which(ee[,1]==root),2]
  d<-diff(pp$yy[dd])
  n<-floor(d/h)
  y<-seq(h/2,by=h,length.out=n)
  y<-(y-mean(y))+mean(pp$yy[dd])
  x<-rep(pp$xx[root],length(y))
  text(x,y,"|")
  if(hasArg(fsize)) fsize<-list(...)$fsize
  else fsize<-1
  for(i in 1:Ntip(tree)) text(pp$xx[i],pp$yy[i],
    tree$tip.label[i],pos=4,cex=fsize)
}
ansi_phylo2(salamanders)

plot of chunk unnamed-chunk-3

Cool?

No comments:

Post a Comment

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