Find bipartitions in trees

compare_get_groups.R

getGroups <- function(tree) {
  getCnnctngEdges <- function(edge) {
    nd <- tree$edge[edge, 1]
    edge <- which(tree$edge[ ,2] == nd)
    if(length(edge) > 0) {
      edge <- c(edge, getCnnctngEdges(edge))
    }
    edge
  }
  .fillInEdgeTips <- function(i) {
    edge.tips[tip.edges[i], i] <<- TRUE
    for(e in getCnnctngEdges(tip.edges[i])) {
      edge.tips[e, i] <<- TRUE
    }
  }
  .fillInRes <- function(i) {
    res <- vector('list', length=2)
    res[[1]] <- which(edge.tips[i, ])
    res[[2]] <- which(!edge.tips[i, ])
    res
  }
  edge.tips <- matrix(FALSE, nrow=nrow(tree$edge),
                ncol=length(tree$tip.label))
  tip.nodes <- 1:length(tree$tip.label)
  tip.edges <- which(tree$edge[,2] %in% tip.nodes)
  lapply(tip.nodes, .fillInEdgeTips)
  lapply(1:nrow(edge.tips), .fillInRes)
}

library(ape)
tree_sizes <- seq(10, 2000, 100)
tm_ori <- tm_new <- rep(NA, length(tree_sizes))
for(i in 1:length(tree_sizes)) {
  tree <- rtree(tree_sizes[i])
  tm_ori[i] <- system.time(expr={
    res_ori <- phylofactor::getGroups(tree)
  })[3]
  tm_new[i] <- system.time(expr={
    res_new <- getGroups(tree)
  })[3]
}
plot(tm_ori~tree_sizes, col=NULL, ylab="Timings (s)")
lines(tm_ori~tree_sizes, col='blue')
lines(tm_new~tree_sizes, col='red')
legend("topleft", legend=c('Original', 'New'), col=c('blue', 'red'),
       lwd=1)