R/heritableTransform.R

In bomeara/utilitree: Various utility functions. Think phytools, but less helpful.

heritableTransform <-
function(phy,rate=1) {
  tips<-abs(1+sim.char(phy,matrix(rate),model="brownian",nsims=1))
  ancstates<-(ace(tips,phy))$ace
  ancstates<-ancstates[-1] #remove root value
  matches<-match(as.numeric(names(ancstates)),phy$edge[,2])
  phy$edge.length[matches]<-phy$edge.length[matches]*ancstates
  tip.id<-match(row.names(tips),phy$tip.label)
  matches<-match(tip.id,phy$edge[,2])
  phy$edge.length[matches]<-phy$edge.length[matches]*tips
  return(phy)
}