R/compute.brtime.R

   1 ## compute.brtime.R (2011-07-26)
   2
   3 ##   Compute and Set Branching Times
   4
   5 ## Copyright 2011 Emmanuel Paradis
   6
   7 ## This file is part of the R-package `ape'.
   8 ## See the file ../COPYING for licensing issues.
   9
  10 compute.brtime <-
  11     function(phy, method = "coalescent", force.positive = NULL)
  12 {
  13     if (!inherits(phy, "phylo"))
  14         stop('object "phy" is not of class "phylo"')
  15     n <- length(phy$tip.label)
  16     m <- phy$Nnode
  17     N <- Nedge(phy)
  18
  19     ## x: branching times (aka, node ages or heights)
  20
  21     if (identical(method, "coalescent")) { # the default
  22         x <- 2 * rexp(m)/(as.double((m + 1):2) * as.double(m:1))
  23         ## x <- 2 * rexp(n - 1)/(as.double(n:2) * as.double((n - 1):1))
  24         if (is.null(force.positive)) force.positive <- TRUE
  25     } else if (is.numeric(method)) {
  26         x <- as.vector(method)
  27         if (length(x) != m)
  28             stop("number of branching times given is not equal to the number of nodes")
  29         if (is.null(force.positive))
  30             force.positive <- FALSE
  31     }
  32
  33     y <- c(rep(0, n), x) # for all nodes (terminal and internal)
  34
  35     phy <- reorder(phy, "pruningwise")
  36     e1 <- phy$edge[, 1L] # local copies of the pointer
  37     e2 <- phy$edge[, 2L] #
  38     el <- numeric(N)
  39     if (force.positive) y[unique(e1)] <- sort(x)
  40
  41     for (i in 1:N) el[i] <- y[e1[i]] - y[e2[i]]
  42
  43     phy$edge.length <- el
  44     reorder(phy)
  45 }
  46