R/is.ultrametric.R

   1 ## is.ultrametric.R (2009-05-10)
   2
   3 ##   Test if a Tree is Ultrametric
   4
   5 ## Copyright 2003-2009 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     phy <- reorder(phy)
  17     n <- length(phy$tip.label)
  18     n.node <- phy$Nnode
  19
  20     ## xx: vecteur donnant la distance d'un
  21     ## noeud ou tip à partir de la racine
  22     xx <- numeric(n + n.node)
  23
  24     for (i in 1:dim(phy$edge)[1])
  25       xx[phy$edge[i, 2]] <- xx[phy$edge[i, 1]] + phy$edge.length[i]
  26
  27     if (identical(all.equal.numeric(var(xx[1:n]),
  28                                     0, tolerance = tol), TRUE)) TRUE
  29     else FALSE
  30 }