R/is.monophyletic.R

   1 ## is.monophyletic.R (2012-03-23)
   2
   3 ##   Test Monophyly
   4
   5 ## Copyright 2009-2012 Johan Nylander and Emmanuel Paradis
   6
   7 ## This file is part of the R-package `ape'.
   8 ## See the file ../COPYING for licensing issues.
   9
  10 is.monophyletic <-
  11     function(phy, tips, reroot = !is.rooted(phy), plot = FALSE, ...)
  12 {
  13     if (!inherits(phy, "phylo"))
  14         stop("object 'phy' is not of class 'phylo'")
  15     n <- length(phy$tip.label)
  16     if (length(tips) %in% c(1L, n)) return(TRUE)
  17     ROOT <- n + 1L
  18     if (is.numeric(tips)) {
  19         if (any(tips > n))
  20             stop("incorrect tip#: should not be greater than the number of tips")
  21         tips <- sort(as.integer(tips))
  22     }
  23     if (is.character(tips))
  24         tips <- which(phy$tip.label %in% tips)
  25
  26     if (reroot) {
  27         outgrp <- phy$tip.label[-tips][1]
  28         phy <- root(phy, outgroup = outgrp, resolve.root = TRUE)
  29         rerooted <- TRUE
  30     } else rerooted <- FALSE
  31
  32     phy <- reorder(phy)
  33
  34     seq.nod <- .Call("seq_root2tip", phy$edge, n, phy$Nnode, PACKAGE = "ape")
  35     sn <- seq.nod[tips]
  36     newroot <- ROOT
  37     i <- 2
  38     repeat {
  39         x <- unique(unlist(lapply(sn, "[", i)))
  40         if (length(x) != 1) break
  41         newroot <- x
  42         i <- i + 1
  43     }
  44     desc <- which(unlist(lapply(seq.nod, function(x) any(x %in% newroot))))
  45     if (plot) {
  46         zoom(phy, tips, subtree = FALSE, ...)
  47         if (rerooted)
  48             mtext("Input tree arbitrarily rerooted", side = 1, cex = 0.9)
  49     }
  50     ## assuming that both vectors are sorted:
  51     identical(tips, desc)
  52 }