From: paradis Date: Tue, 25 May 2010 15:53:24 +0000 (+0000) Subject: new operators for "multiPhylo" + fixed small bug in bind.tree() X-Git-Url: https://git.donarmstrong.com/?p=ape.git;a=commitdiff_plain;h=0875d81d5ba5e6dfe79d42c21b0284b674c73949 new operators for "multiPhylo" + fixed small bug in bind.tree() git-svn-id: https://svn.mpl.ird.fr/ape/dev/ape@122 6e262413-ae40-0410-9e79-b911bd7a66b7 --- diff --git a/ChangeLog b/ChangeLog index 229acbe..2ccbdf4 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,26 @@ + CHANGES IN APE VERSION 2.5-3 + + +NEW FEATURES + + o There are now replacement operators for [, [[, and $ for the class + "multiPhylo" (i.e., TREES[11:20] <- rmtree(10, 100)). They check + that the tip labels are the same in all trees. + + o Objects of class "multiPhylo" can be built with c(): there are + methods for the classes "phylo" and "multiPhylo". + + o The internal functions .compressTipLabel and .uncompressTipLabel are + now documented. + + +BUG FIXES + + o bind.tree(x, y, where, position = 0) did not work correctly if 'y' + was a single-edge tree and 'where' was a tip. + + + CHANGES IN APE VERSION 2.5-2 @@ -40,7 +63,7 @@ OTHER CHANGES - CHANGES IN APE VERSION 2.5-1 + CHANGES IN APE VERSION 2.5-1 NEW FEATURES @@ -87,7 +110,7 @@ OTHER CHANGES - CHANGES IN APE VERSION 2.5 + CHANGES IN APE VERSION 2.5 NEW FEATURES diff --git a/DESCRIPTION b/DESCRIPTION index ebf8a80..bb68ebf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ape -Version: 2.5-2 -Date: 2010-05-17 +Version: 2.5-3 +Date: 2010-05-25 Title: Analyses of Phylogenetics and Evolution Author: Emmanuel Paradis, Ben Bolker, Julien Claude, Hoa Sien Cuong, Richard Desper, Benoit Durand, Julien Dutheil, Olivier Gascuel, 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/NAMESPACE b/NAMESPACE index 01e3dca..6951d42 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,5 +21,6 @@ S3method(print, DNAbin) S3method(cbind, DNAbin) S3method(rbind, DNAbin) S3method("[", DNAbin) -S3method(summary, DNAbin) +S3method(labels, DNAbin) S3method(as.character, DNAbin) +S3method(as.matrix, DNAbin) diff --git a/R/bind.tree.R b/R/bind.tree.R index 4202e2e..b862b37 100644 --- a/R/bind.tree.R +++ b/R/bind.tree.R @@ -1,4 +1,4 @@ -## bind.tree.R (2010-03-15) +## bind.tree.R (2010-05-25) ## Bind Trees @@ -46,7 +46,7 @@ bind.tree <- function(x, y, where = "root", position = 0, interactive = FALSE) wbl <- TRUE, { x$edge.length <- y$edge.length <- NULL wbl <- FALSE - warning("one tree has no branch lengths, they will be ignored") + warning("one tree has no branch lengths, they have been ignored") }, wbl <- FALSE) @@ -77,6 +77,14 @@ bind.tree <- function(x, y, where = "root", position = 0, interactive = FALSE) } } + ## the special of substituting two tips: + if (case == 2 && ny == 1 && !position) { + x$tip.label[x$edge[i, 2]] <- y$tip.label + if (wbl) + x$edge.length[i] <- x$edge.length[i] + y$edge.length + return(x) + } + x <- reorder(x) y <- reorder(y) diff --git a/R/dist.topo.R b/R/dist.topo.R index 779db02..eb9ba6f 100644 --- a/R/dist.topo.R +++ b/R/dist.topo.R @@ -1,4 +1,4 @@ -## dist.topo.R (2010-05-06) +## dist.topo.R (2010-05-25) ## Topological Distances, Tree Bipartitions, ## Consensus Trees, and Bootstrapping Phylogenies @@ -72,15 +72,21 @@ dist.topo <- function(x, y, method = "PH85") stop("some tip labels are duplicated in tree no. 1") n <- length(ref) for (i in 2:length(x)) { - if (identical(x[[i]]$tip.label, ref)) next - ilab <- match(x[[i]]$tip.label, ref) - ## can use tabulate here because 'ilab' contains integers - if (any(tabulate(ilab) > 1)) - stop(paste("some tip labels are duplicated in tree no.", i)) - if (any(is.na(ilab))) - stop(paste("tree no.", i, "has different tip labels")) - ie <- match(1:n, x[[i]]$edge[, 2]) - x[[i]]$edge[ie, 2] <- ilab + label <- x[[i]]$tip.label + if (!identical(label, ref)) { + if (length(label) != length(ref)) + stop(paste("tree no.", i, "has a different number of tips")) + ilab <- match(label, ref) + ## can use tabulate here because 'ilab' contains integers + if (any(is.na(ilab))) + stop(paste("tree no.", i, "has different tip labels")) +### the test below does not seem useful anymore +### if (any(tabulate(ilab) > 1)) +### stop(paste("some tip labels are duplicated in tree no.", i)) +### + ie <- match(1:n, x[[i]]$edge[, 2]) + x[[i]]$edge[ie, 2] <- ilab + } x[[i]]$tip.label <- NULL } x[[1]]$tip.label <- NULL diff --git a/R/summary.phylo.R b/R/summary.phylo.R index 592050c..bf01266 100644 --- a/R/summary.phylo.R +++ b/R/summary.phylo.R @@ -1,8 +1,8 @@ -## summary.phylo.R (2009-05-10) +## summary.phylo.R (2010-05-25) -## Print Summary of a Phylogeny +## Print Summary of a Phylogeny and "multiPhylo" operators -## Copyright 2003-2009 Emmanuel Paradis, and 2006 Ben Bolker +## Copyright 2003-2010 Emmanuel Paradis, and 2006 Ben Bolker ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. @@ -146,3 +146,99 @@ str.multiPhylo <- function(object, ...) cat('Class "multiPhylo"\n') str(object, ...) } + +c.phylo <- function(..., recursive = FALSE) + structure(list(...), class = "multiPhylo") +## only the first object in '...' is checked for its class, +## but that should be OK for the moment + +c.multiPhylo <- function(..., recursive = FALSE) +{ + obj <- list(...) + n <- length(obj) + x <- obj[[1L]] + N <- length(x) + i <- 1L + while (i < n) { + a <- N + 1L + N <- N + length(obj[[i]]) + ## x is of class "multiPhylo", so this uses the operator below: + x[a:N] <- obj[[i]] + i <- i + 1L + } + x +} + +.uncompressTipLabel <- function(x) +{ + Lab <- attr(x, "TipLabel") + if (is.null(Lab)) return(x) + class(x) <- NULL + for (i in 1:length(x)) x[[i]]$tip.label <- Lab + class(x) <- "multiPhylo" + attr(x, "TipLabel") <- NULL + x +} + +`[<-.multiPhylo` <- function(x, ..., value) +{ + ## recycling is allowed so no need to check: length(value) != length(..1) + + ## check that all elements in 'value' inherit class "phylo" + test <- unlist(lapply(value, function(xx) !inherits(xx, "phylo"))) + if (any(test)) + stop("at least one element in 'value' is not of class \"phylo\".") + + oc <- oldClass(x) + class(x) <- NULL + + if (is.null(attr(x, "TipLabel"))) { + x[..1] <- value + class(x) <- oc + return(x) + } + + x[..1] <- 0L # in case x needs to be elongated + class(x) <- oc + j <- 1L + for (i in ..1) { + ## x is of class "multiPhylo", so this uses the operator below: + x[[i]] <- value[[j]] + j <- j + 1L + } + x +} + +`[[<-.multiPhylo` <- function(x, ..., value) +{ + if (!inherits(value, "phylo")) + stop('trying to assign an object not of class "phylo" into an object of class "multiPhylo".') + + oc <- oldClass(x) + class(x) <- NULL + + Lab <- attr(x, "TipLabel") + + if (!is.null(Lab)) { + n <- length(Lab) + if (n != length(value$tip.label)) + stop("tree with different number of tips than those in the list (which all have the same labels; maybe you want to uncompress them)") + + o <- match(value$tip.label, Lab) + if (any(is.na(o))) + stop("tree tip labels do not match with those in the list; maybe you want to uncompress them.") + value$tip.label <- NULL + ie <- match(o, value$edge[, 2]) + value$edge[ie, 2] <- 1:n + } + + x[[..1]] <- value + class(x) <- oc + x +} + +`$<-.multiPhylo` <- function(x, ..., value) +{ + x[[..1]] <- value + x +} diff --git a/man/c.phylo.Rd b/man/c.phylo.Rd new file mode 100644 index 0000000..98497f3 --- /dev/null +++ b/man/c.phylo.Rd @@ -0,0 +1,55 @@ +\name{c.phylo} +\alias{c.phylo} +\alias{c.multiPhylo} +\alias{.compressTipLabel} +\alias{.uncompressTipLabel} +\title{Building Lists of Trees} +\description{ + These functions help to build lists of trees of class \code{"multiPhylo"}. +} +\usage{ +\method{c}{phylo}(..., recursive = FALSE) +\method{c}{multiPhylo}(..., recursive = FALSE) +.compressTipLabel(x) +.uncompressTipLabel(x) +} +\arguments{ + \item{\dots}{one or several objects of class \code{"phylo"} or + \code{"multiPhylo"}.} + \item{recursive}{for compatibily with the generic (do not change).} + \item{x}{an object of class \code{"phylo"} or \code{"multiPhylo"}.} +} +\details{ + These \code{c} methods do not check all the arguments, so it is the + user's responsibility to make sure that only objects of the same class + (either \code{"phylo"} or \code{"multiPhylo"}) are used. + + \code{.compressTipLabel} transforms an object of class + \code{"multiPhylo"} by checking that all trees have the same tip + labels and renumbering the tips in the \code{edge} matrix so that the + tip numbers are also the same taking the first tree as the reference + (duplicated labels are not allowed). The returned object has a unique + vector of tip labels (\code{attr(x, "TipLabel")}). + + \code{.uncompressTipLabel} does the reverse operation. +} +\value{ + An object of class \code{"multiPhylo"}. +} +\author{Emmanuel Paradis} +\seealso{ + \code{\link{summary.phylo}}, \code{\link{multiphylo}} +} +\examples{ +x <- c(rtree(4), rtree(2)) +x +y <- c(rtree(4), rtree(4)) +z <- c(x, y) +z +print(z, TRUE) +try(.compressTipLabel(x)) # error +a <- .compressTipLabel(y) +.uncompressTipLabel(a) # back to y +## eventually compare str(a) and str(y) +} +\keyword{manip} diff --git a/man/multiphylo.Rd b/man/multiphylo.Rd new file mode 100644 index 0000000..45368ad --- /dev/null +++ b/man/multiphylo.Rd @@ -0,0 +1,69 @@ +\name{multiphylo} +\alias{multiphylo} +\alias{[.multiPhylo} +\alias{[[.multiPhylo} +\alias{$.multiPhylo} +\alias{[<-.multiPhylo} +\alias{[[<-.multiPhylo} +\alias{$<-.multiPhylo} +\title{Manipulating Lists of Trees} +\description{ + These are extraction and replacement operators for lists of trees + stored in the class \code{"multiPhylo"}. +} +\usage{ +\method{[}{multiPhylo}(x, i) +\method{[[}{multiPhylo}(x, i) +\method{$}{multiPhylo}(x, name) +\method{[}{multiPhylo}(x, ...) <- value +\method{[[}{multiPhylo}(x, ...) <- value +\method{$}{multiPhylo}(x, ...) <- value +} +\arguments{ + \item{x, value}{an object of class \code{"phylo"} or \code{"multiPhylo"}.} + \item{i}{index(ices) of the tree(s) to select from a list; this may be a + vector of integers, logicals, or names.} + \item{name}{a character string specifying the tree to be extracted.} + \item{\dots}{index(ices) of the tree(s) to replace; this may be a + vector of integers, logicals, or names.} +} +\details{ + The subsetting operator \code{[} keeps the class correctly + (\code{"multiPhylo"}). + +The replacement operators check the labels of \code{value} if \code{x} +has a single vector of tip labels for all trees (see examples). +} +\value{ + An object of class \code{"phylo"} (\code{[[}, \code{$}) or of class + \code{"multiPhylo"} (\code{[} and the replacement operators). +} +\author{Emmanuel Paradis} +\seealso{ + \code{\link{summary.phylo}}, \code{\link{c.phylo}} +} +\examples{ +x <- rmtree(10, 20) +names(x) <- paste("tree", 1:10, sep = "") +x[1:5] +x[1] # subsetting +x[[1]] # extraction +x$tree1 # same than above +x[[1]] <- rtree(20) + +y <- .compressTipLabel(x) +## up to here 'x' and 'y' have exactly the same information +## but 'y' has a unique vector of tip labels for all the trees +x[[1]] <- rtree(10) # no error +try(y[[1]] <- rtree(10)) # error + +try(x[1] <- rtree(20)) # error +## use instead one of the two: +x[1] <- list(rtree(20)) +x[1] <- c(rtree(20)) + +x[1:5] <- rmtree(5, 20) # replacement +x[11:20] <- rmtree(10, 20) # elongation +x # 20 trees +} +\keyword{manip} diff --git a/man/print.phylo.Rd b/man/print.phylo.Rd index 466fe87..68aa405 100644 --- a/man/print.phylo.Rd +++ b/man/print.phylo.Rd @@ -1,17 +1,11 @@ \name{print.phylo} \alias{print.phylo} \alias{print.multiPhylo} -\alias{[.multiPhylo} -\alias{[[.multiPhylo} -\alias{$.multiPhylo} \alias{str.multiPhylo} \title{Compact Display of a Phylogeny} \usage{ \method{print}{phylo}(x, printlen = 6 ,...) \method{print}{multiPhylo}(x, details = FALSE ,...) -\method{[}{multiPhylo}(x, i) -\method{[[}{multiPhylo}(x, i) -\method{$}{multiPhylo}(x, name) \method{str}{multiPhylo}(object, ...) } \arguments{ @@ -20,25 +14,27 @@ \item{printlen}{the number of labels to print (6 by default).} \item{details}{a logical indicating whether to print information on all trees.} - \item{i}{indices of the tree(s) to select from a list; this may be a - vector of integers, logicals, or names.} - \item{name}{a character string specifying the tree to be extracted.} \item{\dots}{further arguments passed to or from other methods.} } \description{ These functions prints a compact summary of a phylogeny, or a list of phylogenies, on the console. - - The operators \code{[}, \code{[[}, and \code{$} propagate the class - correctly. } \value{ - An object of class \code{"phylo"} (\code{[[}, \code{$}) or of class - \code{"multiPhylo"} (\code{[}), or NULL. + NULL. } \author{Ben Bolker \email{bolker@zoo.ufl.edu} and Emmanuel Paradis} \seealso{ \code{\link{read.tree}}, \code{\link{summary.phylo}}, \code{\link[base]{print}} for the generic R function } +\examples{ +x <- rtree(10) +print(x) +print(x, printlen = 10) +x <- rmtree(2, 10) +print(x) +print(x, TRUE) +str(x) +} \keyword{manip} diff --git a/man/summary.phylo.Rd b/man/summary.phylo.Rd index 6278760..984b65a 100644 --- a/man/summary.phylo.Rd +++ b/man/summary.phylo.Rd @@ -41,7 +41,7 @@ Nedge(phy) \author{Emmanuel Paradis} \seealso{ \code{\link{read.tree}}, \code{\link[base]{summary}} for the generic R - function + function, \code{\link{multiphylo}}, \code{\link{c.phylo}} } \examples{ data(bird.families)