R Functions

makebinary - a function that uses a newick tree that may or may not already be completely bifurcating and returns a binary tree as a string

makebinary = function(newick) {
  tree = read.tree(text = newick)
  if(is.binary.tree(tree)) {
    return(newick)
  } else {
    return(write.tree(multi2di(tree)))
  }
}

animateSimmap - a function that produces an animated gif of multiple SIMMAP mappings of a trait on a tree

animateSimmap = function(phy, interval = .02, numb = length(phy), name = "animation.gif", ...) {
  if(class(phy) != "multiPhylo") stop("object must be multiPhylo")
  saveGIF(for(i in 1:numb) {
            dev.hold()
            plotSimmap(phy[[i]], ...)
            Sys.sleep(interval)
          }, movie.name = name)
}

mappedNode - a function that finds the character state at each node in a SIMMAP tree. It returns a named vector where the names correspond to the node names

mappedNode = function(phy) {
  # phy must be a SIMMAP tree
  nodes = phy$edge[,1] # this gives us the starting node for all edges
  map = sapply(phy$maps, function(x) attr(x, "names")[1]) # this gives us the starting value of each branch
  df = unique(data.frame(nodes = nodes, map = map)) # here we're removing the repeated values as interior nodes will have multiple branches
  mapping = df$map
  names(mapping) = df$nodes # naming the vector with node names
  mapping
}

transformPresAbs - a function that takes a vector of species and locations in which that species is found (such that each species and location may occur multiple times), and turns it into a presence/absence matrix with rows representing species and columns representing locations

transformPresAbs = function(species, location) {

  # find the unique species and locations 
  ulocations = unique(location)
  uspecies = unique(species)

  # initialize the matrix with the proper dimensions
  # first start with a matrix to make specifying the dimensions easier
  presAbs = matrix(NA, ncol = length(ulocations), nrow = length(uspecies))
  # then name the columns and rows with the locations and species, respectively
  colnames(presAbs) = levels(location)
  rownames(presAbs) = levels(uspecies)
  
  for(i in 1:nrow(presAbs)) { # here we're iterating over the rows (species)
    presAbs[i,1:ncol(presAbs)] = sapply(colnames(presAbs), function(x) {
    # here we're iterating over the columns (locations)
      if(any(df[which(species == rownames(presAbs)[i]),] == x)) 1 # assign 1 if present
      else 0
    })
  }
  
  # show us what we got!
  return(presAbs)
}