R/is.ultrametric.R

   1 ## is.ultrametric.R (2012-02-09)
   2
   3 ##   Test if a Tree is Ultrametric
   4
   5 ## Copyright 2003-2012 Emmanuel Paradis
   6
   7 ## This file is part of the R-package `ape'.
   8 ## See the file ../COPYING for licensing issues.
   9
  10 is.ultrametric <- function(phy, tol = .Machine$double.eps^0.5)
  11 {
  12     if (!inherits(phy, "phylo"))
  13         stop('object "phy" is not of class "phylo"')
  14     if (is.null(phy$edge.length))
  15         stop("the tree has no branch lengths")
  16
  17     phy <- reorder(phy)
  18     n <- length(phy$tip.label)
  19     e1 <- phy$edge[, 1]
  20     e2 <- phy$edge[, 2]
  21     EL <- phy$edge.length
  22
  23     ## xx: vecteur donnant la distance d'un noeud
  24     ##     ou d'un tip à partir de la racine
  25     xx <- numeric(n + phy$Nnode)
  26
  27     ## the following must start at the root and follow the
  28     ## edges contiguously; so the tree must be either in cladewise
  29     ## order (or in pruningwise but the for loop must start from
  30     ## the bottom of the edge matrix)
  31
  32     for (i in seq_len(length(e1)))
  33         xx[e2[i]] <- xx[e1[i]] + EL[i]
  34
  35     isTRUE(all.equal.numeric(var(xx[1:n]), 0, tolerance = tol))
  36 }