From 8583b8f50f7747a557dbaf6678207da5108087f9 Mon Sep 17 00:00:00 2001 From: paradis Date: Fri, 19 Jun 2009 13:59:08 +0000 Subject: [PATCH] new is.monophyletic() + various changes/fixes git-svn-id: https://svn.mpl.ird.fr/ape/dev/ape@78 6e262413-ae40-0410-9e79-b911bd7a66b7 --- ChangeLog | 7 +++++ DESCRIPTION | 2 +- R/drop.tip.R | 11 ++++---- R/is.monophyletic.R | 53 +++++++++++++++++++++++++++++++++++++ R/write.tree.R | 9 ++++--- R/zoom.R | 13 +++++----- man/is.monophyletic.Rd | 59 ++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 136 insertions(+), 18 deletions(-) create mode 100644 R/is.monophyletic.R create mode 100644 man/is.monophyletic.Rd diff --git a/ChangeLog b/ChangeLog index efef3ba..a1c4552 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,8 @@ NEW FEATURES + o The new function is.monophyletic tests the monophyly of a group. + o There is now a c() method for lists of class "DNAbin". o yule.cov() now fits the null model, and its help page has been @@ -26,6 +28,8 @@ BUG FIXES the fix. With other improvements, this function is now about 6 times faster. + o write.tree() failed with objects of class "multiPhylo". + OTHER CHANGES @@ -36,6 +40,9 @@ OTHER CHANGES o rcoal() is now faster. + +DEPRECATED & DEFUNCT + o klastorin() has been removed. diff --git a/DESCRIPTION b/DESCRIPTION index 42abd25..0b18830 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ape Version: 2.3-1 -Date: 2009-06-12 +Date: 2009-06-19 Title: Analyses of Phylogenetics and Evolution Author: Emmanuel Paradis, Ben Bolker, Julien Claude, Hoa Sien Cuong, Richard Desper, Benoit Durand, Julien Dutheil, Olivier Gascuel, Gangolf Jobb, Christoph Heibl, Daniel Lawson, Vincent Lefort, Pierre Legendre, Jim Lemon, Yvonnick Noel, Johan Nylander, Rainer Opgen-Rhein, Korbinian Strimmer, Damien de Vienne Maintainer: Emmanuel Paradis diff --git a/R/drop.tip.R b/R/drop.tip.R index efa429a..a4a3d03 100644 --- a/R/drop.tip.R +++ b/R/drop.tip.R @@ -96,24 +96,23 @@ drop.tip <- ## find the tips to drop: if (is.character(tip)) tip <- which(phy$tip.label %in% tip) - trms <- edge2 <= Ntip ## delete the terminal edges given by `tip': keep[match(tip, edge2)] <- FALSE if (trim.internal) { - ## delete the internal edges that do not have descendants - ## anymore (ie, they are in the 2nd column of `edge' but + internals <- edge2 <= Ntip + ## delete the internal edges that do not have anymore + ## descendants (ie, they are in the 2nd col of `edge' but ## not in the 1st one) repeat { - sel <- !(edge2 %in% edge1[keep]) & !trms & keep + sel <- !(edge2 %in% edge1[keep]) & internals & keep if (!sum(sel)) break keep[sel] <- FALSE } if (subtree) { ## keep the subtending edge(s): subt <- edge1 %in% edge1[keep] & edge1 %in% edge1[!keep] - ## 'if (... ' needed below? - if (any(subt)) keep[which(subt)] <- TRUE + keep[subt] <- TRUE } if (root.edge && wbl) { degree <- tabulate(edge1[keep]) diff --git a/R/is.monophyletic.R b/R/is.monophyletic.R new file mode 100644 index 0000000..d25264b --- /dev/null +++ b/R/is.monophyletic.R @@ -0,0 +1,53 @@ +## ace.R (2009-06-19) + +## Ancestral Character Estimation + +## Copyright 2009 Johan Nylander and Emmanuel Paradis + +## This file is part of the R-package `ape'. +## See the file ../COPYING for licensing issues. + +is.monophyletic <- + function(phy, tips, reroot = !is.rooted(phy), plot = FALSE, ...) +{ + if (!inherits(phy, "phylo")) + stop("object 'phy' is not of class 'phylo'") + if (length(tips) == 1) return(TRUE) + n <- length(phy$tip.label) + if (length(tips) == n) return(TRUE) + ROOT <- n + 1 + if (is.numeric(tips)) { + if (any(tips > n)) + stop("incorrect tip#: should not be greater than the number of tips") + tips <- sort(tips) + } + if (is.character(tips)) + tips <- which(phy$tip.label %in% tips) + + if (reroot) { + outgrp <- phy$tip.label[-tips][1] + phy <- root(phy, outgroup = outgrp, resolve.root = TRUE) + rerooted <- TRUE + } else rerooted <- FALSE + + phy <- reorder(phy) + + seq.nod <- .Call("seq_root2tip", phy$edge, n, phy$Nnode, PACKAGE = "ape") + sn <- seq.nod[tips] + newroot <- ROOT + i <- 2 + repeat { + x <- unique(unlist(lapply(sn, "[", i))) + if (length(x) != 1) break + newroot <- x + i <- i + 1 + } + desc <- which(unlist(lapply(seq.nod, function(x) any(x %in% newroot)))) + if (plot) { + zoom(phy, tips, subtree = FALSE, ...) + if (rerooted) + mtext("Input tree arbitrarily rerooted", side = 1, cex = 0.9) + } + ## assuming that both vectors are sorted: + identical(tips, desc) +} # end of is.monophyletic diff --git a/R/write.tree.R b/R/write.tree.R index 1669e53..996b9aa 100644 --- a/R/write.tree.R +++ b/R/write.tree.R @@ -1,4 +1,4 @@ -## write.tree.R (2009-05-10) +## write.tree.R (2009-06-16) ## Write Tree File in Parenthetic Format @@ -30,18 +30,19 @@ checkLabel <- function(x, ...) write.tree <- function (phy, file = "", append = FALSE, digits = 10, tree.names = FALSE) { + output.tree.names <- FALSE if (is.logical(tree.names)) { output.tree.names <- tree.names tree.names <- NULL } else if (is.character(tree.names)) { output.tree.names <- TRUE - names(tree) <- tree.names + names(phy) <- tree.names } if (output.tree.names) - names(tree) <- checkLabel(names(tree)) + names(phy) <- checkLabel(names(phy)) if (inherits(phy, "multiPhylo")) { write.tree(phy[[1]], file = file, append = append, - digits = digits, tree.names = names[1]) + digits = digits, tree.names = names(phy)[1]) if (length(phy) > 1) for (i in 2:length(phy)) write.tree(phy[[i]], file = file, append = TRUE, digits = digits, tree.names = names(phy)[i]) diff --git a/R/zoom.R b/R/zoom.R index 49deac2..f078bb4 100644 --- a/R/zoom.R +++ b/R/zoom.R @@ -1,8 +1,8 @@ -## zoom.R (2008-04-16) +## zoom.R (2009-06-12) ## Zoom on a Portion of a Phylogeny -## Copyright 2003-2008 Emmanuel Paradis +## Copyright 2003-2009 Emmanuel Paradis ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. @@ -14,11 +14,10 @@ zoom <- function(phy, focus, subtree = FALSE, col = rainbow, ...) for (i in 1:n) if (is.character(focus[[i]])) focus[[i]] <- which(phy$tip.label %in% focus[[i]]) # fix by Yan Wong - if (is.function(col)) - if (deparse(substitute(col)) == "grey") - col <- grey(1:n/n) else col <- col(n) - ext <- list() - length(ext) <- n + if (is.function(col)) { + col <- if (deparse(substitute(col)) == "grey") grey(1:n/n) else col(n) + } + ext <- vector("list", n) for (i in 1:n) ext[[i]] <- drop.tip(phy, phy$tip.label[-focus[[i]]], subtree = subtree) diff --git a/man/is.monophyletic.Rd b/man/is.monophyletic.Rd new file mode 100644 index 0000000..45aafe1 --- /dev/null +++ b/man/is.monophyletic.Rd @@ -0,0 +1,59 @@ +\name{is.monophyletic} +\alias{is.monophyletic} +\title{ + Is Group Monophyletic +} +\usage{ +is.monophyletic(phy, tips, reroot = NULL, plot = FALSE, ...) +} +\description{ + This function tests whether a list of tip labels is monophyletic on a given tree. +} +\arguments{ + \item{phy}{ + a phylogenetic tree description of class \code{"phylo"}. + } + \item{tips}{ + a vector of mode numeric or character specifying the tips to be tested. + } + \item{reroot}{ + a logical. If \code{FALSE}, then the input tree is not unrooted before the test. + } + \item{plot}{ + a logical. If \code{TRUE}, then the tree is plotted with the specified group \code{tips} highlighted. + } + \item{...}{ + further arguments passed to \code{plot}. + } +} +\details{ + If \code{phy} is rooted, the test is done on the rooted tree, otherwise + the tree is first unrooted, then arbitrarily rerooted, in order to be + independent on the current position of the root. That is, the test + asks if \code{tips} could be monophyletic given any favourably rooting + of \code{phy}. + + If \code{phy} is unrooted the test is done on an unrooted tree, unless + \code{reroot = FALSE} is specified. + + If tip labels in the list \code{tips} are given as characters, they need + to be spelled as in the object \code{phy}. +} +\value{ + \code{TRUE} or \code{FALSE}. +} +\author{ + Johan Nylander \email{jnylander@users.sourceforge.net} +} +\seealso{ + \code{\link{which.edge}}, \code{\link{drop.tip}}, \code{\link{mrca}}. +} +\examples{ + ## Test one monophyletic and one paraphyletic group on the bird.orders tree + \dontrun{data("bird.orders")} + \dontrun{is.monophyletic(phy = bird.orders, tips = c("Ciconiiformes", "Gruiformes"))} + \dontrun{is.monophyletic(bird.orders, c("Passeriformes", "Ciconiiformes", "Gruiformes"))} + \dontshow{\dontrun{rm(bird.orders)}} +} +\keyword{utilities} + -- 2.39.5