R/brts2phylo_with_stem.R

In Neves-P/utilSIE: Utility Functions for DAISIE

#This function will build a phylogeny where all branching
#time cause speciations within the same clade resulting
#in a tree with a single radiation and an outgroup (stem)
brts2phylo_with_stem <- function (times,
                                  root = FALSE,
                                  tip.label = NULL)
{
  times = sort(times)
  n <- as.integer(length(times)) + 1
  if (root == TRUE) {
    n <- n - 1
  }
  nbr <- 2 * n - 2
  edge <- matrix(NA, nbr, 2)
  edge.length <- numeric(nbr)
  h <- numeric(2 * n - 1)
  pool <- 1:n
  nextnode <- 2L * n - 1L
  if (n > 1) {
    for (i in 1:(n - 1)) {
      y <- sample(pool, size = 2)
      ind <- (i - 1) * 2 + 1:2
      edge[ind, 1] <- nextnode
      edge[ind, 2] <- y
      edge.length[ind] <- times[i] - h[y]
      h[nextnode] <- times[i]
      pool <- c(pool[!pool %in% y], nextnode)
      nextnode <- nextnode - 1L
    }
  }
  phy <- list(edge = edge, edge.length = edge.length)
  if (is.null(tip.label))
    tip.label <- paste("t", 1:n, sep = "")
  phy$tip.label <- sample(tip.label)
  phy$Nnode <- n - 1L
  if (root) {
    phy$root.edge <- times[n] - times[n - 1]
    phy$root <- times[n] - times[n - 1]
  }
  class(phy) <- "phylo"
  phy <- stats::reorder(phy)
  phy$edge[phy$edge[, 2] <= n, 2] <- 1:n
  return(phy)
}