From: paradis Date: Sat, 13 Mar 2010 13:46:54 +0000 (+0000) Subject: few corrections and fixes X-Git-Url: https://git.donarmstrong.com/?p=ape.git;a=commitdiff_plain;h=6fe5709ee413e5a1a379918a70c64cee05e9ae54 few corrections and fixes git-svn-id: https://svn.mpl.ird.fr/ape/dev/ape@112 6e262413-ae40-0410-9e79-b911bd7a66b7 --- diff --git a/ChangeLog b/ChangeLog index b1246e0..f59984b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,11 +1,23 @@ CHANGES IN APE VERSION 2.5-1 +NEW FEATURES + + o The new function stree generates trees with regular shapes. + + o drop.tip(), extract.clade(), and root() now have an 'interactive' + option to make the operation on a plotted tree. + + BUG FIXES o rTraitDisc() did not use its 'freq' argument correctly (it was multiplied with the rate matrix column-wise instead of row-wise). + o [node|tip|edge]labels(thermo = ) used to draw empty thermometers + with NA values. Nothing is drawn now like with 'text' or 'pch'. + The same bug occurred with the 'pie' option. + CHANGES IN APE VERSION 2.5 diff --git a/DESCRIPTION b/DESCRIPTION index a71fe22..ce0536b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ape Version: 2.5-1 -Date: 2010-02-03 +Date: 2010-03-12 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/bind.tree.R b/R/bind.tree.R index 9df19b5..8810f41 100644 --- a/R/bind.tree.R +++ b/R/bind.tree.R @@ -1,8 +1,8 @@ -## bind.tree.R (2009-10-08) +## bind.tree.R (2010-02-12) ## Bind Trees -## Copyright 2003-2009 Emmanuel Paradis +## Copyright 2003-2010 Emmanuel Paradis ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. diff --git a/R/compar.gee.R b/R/compar.gee.R index e9075a1..488379c 100644 --- a/R/compar.gee.R +++ b/R/compar.gee.R @@ -20,10 +20,9 @@ do not match: the former were ignored in the analysis.") effect.assign <- attr(model.matrix(formula, data = data), "assign") for (i in all.vars(formula)) { if (any(is.na(eval(parse(text = i), envir = data)))) - stop("the present method cannot (yet) be used directly with missing data: you may consider removing the species with missing data from your tree with the function `drop.tip'.") + stop("the present method cannot (yet) be used directly with missing data: you may consider removing the species with missing data from your tree with the function 'drop.tip'.") } - if (is.null(phy$edge.length)) - stop("the tree has no branch lengths.") + if (is.null(phy$edge.length)) stop("the tree has no branch lengths.") R <- vcv.phylo(phy, cor = TRUE) id <- rep(1, dim(R)[1]) geemod <- do.call("gee", list(formula, id, data = data, family = family, R = R, @@ -33,7 +32,7 @@ do not match: the former were ignored in the analysis.") fname <- if (is.function(family)) deparse(substitute(family)) else family if (fname == "binomial") - W <- summary(glm(formula, family = quasibinomial, data = data))$cov.scaled + W <- summary(glm(formula, family = quasibinomial, data = data))$cov.scaled N <- geemod$nobs dfP <- sum(phy$edge.length)*N / sum(diag(vcv.phylo(phy))) obj <- list(call = geemod$call, diff --git a/R/dist.topo.R b/R/dist.topo.R index 06619ec..1eb770a 100644 --- a/R/dist.topo.R +++ b/R/dist.topo.R @@ -82,8 +82,9 @@ dist.topo <- function(x, y, method = "PH85") stop(paste("tree no.", i, "has different tip labels")) ie <- match(1:n, x[[i]]$edge[, 2]) x[[i]]$edge[ie, 2] <- ilab + x[[i]]$tip.label <- NULL } - for (i in 1:length(x)) x[[i]]$tip.label <- NULL + x[[1]]$tip.label <- NULL attr(x, "TipLabel") <- ref x } diff --git a/R/drop.tip.R b/R/drop.tip.R index 2d2a8f0..e59b59b 100644 --- a/R/drop.tip.R +++ b/R/drop.tip.R @@ -1,29 +1,31 @@ -## drop.tip.R (2009-09-09) +## drop.tip.R (2010-02-11) ## Remove Tips in a Phylogenetic Tree -## Copyright 2003-2009 Emmanuel Paradis +## Copyright 2003-2010 Emmanuel Paradis ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. -extract.clade <- function(phy, node, root.edge = 0) +extract.clade <- function(phy, node, root.edge = 0, interactive = FALSE) { Ntip <- length(phy$tip.label) ROOT <- Ntip + 1 Nedge <- dim(phy$edge)[1] wbl <- !is.null(phy$edge.length) - if (length(node) > 1) { - node <- node[1] - warning("only the first value of 'node' has been considered") - } - if (is.character(node)) { - if (is.null(phy$node.label)) - stop("the tree has no node labels") - node <- which(phy$node.label %in% node) + Ntip + if (interactive) node <- identify(phy)$nodes else { + if (length(node) > 1) { + node <- node[1] + warning("only the first value of 'node' has been considered") + } + if (is.character(node)) { + if (is.null(phy$node.label)) + stop("the tree has no node labels") + node <- which(phy$node.label %in% node) + Ntip + } + if (node <= Ntip) + stop("node number must be greater than the number of tips") } - if (node <= Ntip) - stop("node number must be greater than the number of tips") if (node == ROOT) return(phy) phy <- reorder(phy) # insure it is in cladewise order root.node <- which(phy$edge[, 2] == node) @@ -73,15 +75,27 @@ extract.clade <- function(phy, node, root.edge = 0) drop.tip <- function(phy, tip, trim.internal = TRUE, subtree = FALSE, - root.edge = 0, rooted = is.rooted(phy)) + root.edge = 0, rooted = is.rooted(phy), interactive = FALSE) { if (!inherits(phy, "phylo")) stop('object "phy" is not of class "phylo"') Ntip <- length(phy$tip.label) ## find the tips to drop: - if (is.character(tip)) - tip <- which(phy$tip.label %in% tip) + if (interactive) { + cat("Left-click close to the tips you want to drop; right-click when finished...\n") + xy <- locator() + nToDrop <- length(xy$x) + tip <- integer(nToDrop) + lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv) + for (i in 1:nToDrop) { + d <- sqrt((xy$x[i] - lastPP$xx)^2 + (xy$y[i] - lastPP$yy)^2) + tip[i] <- which.min(d) + } + } else { + if (is.character(tip)) + tip <- which(phy$tip.label %in% tip) + } if (!rooted && subtree) { phy <- root(phy, (1:Ntip)[-tip][1]) diff --git a/R/nodelabels.R b/R/nodelabels.R index 5526b01..9d5b39c 100644 --- a/R/nodelabels.R +++ b/R/nodelabels.R @@ -1,4 +1,4 @@ -## nodelabels.R (2010-01-30) +## nodelabels.R (2010-03-12) ## Labelling Trees @@ -98,6 +98,9 @@ BOTHlabels <- function(text, sel, XX, YY, adj, frame, pch, thermo, rect(xl, yb + rowSums(thermo[, 1:(i - 1), drop = FALSE]), xr, yb + rowSums(thermo[, 1:i]), border = NA, col = piecol[i]) + ## check for NA's before drawing the borders + s <- apply(thermo, 1, function(xx) any(is.na(xx))) + xl[s] <- xr[s] <- NA rect(xl, yb, xr, yb + height, border = "black") segments(xl, YY, xl - width/5, YY) segments(xr, YY, xr + width/5, YY) @@ -109,8 +112,10 @@ BOTHlabels <- function(text, sel, XX, YY, adj, frame, pch, thermo, xrad <- rep(xrad, length(sel)) XX <- XX + adj[1] - 0.5 YY <- YY + adj[2] - 0.5 - for (i in 1:length(sel)) + for (i in 1:length(sel)) { + if (any(is.na(pie[i, ]))) next floating.pie.asp(XX[i], YY[i], pie[i, ], radius = xrad[i], col = piecol) + } } if (!is.null(text)) text(XX, YY, text, adj = adj, col = col, ...) if (!is.null(pch)) points(XX + adj[1] - 0.5, YY + adj[2] - 0.5, diff --git a/R/root.R b/R/root.R index d02044f..ac5ec27 100644 --- a/R/root.R +++ b/R/root.R @@ -1,8 +1,8 @@ -## root.R (2009-11-15) +## root.R (2010-02-11) ## Root of Phylogenetic Trees -## Copyright 2004-2009 Emmanuel Paradis +## Copyright 2004-2010 Emmanuel Paradis ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. @@ -10,19 +10,19 @@ is.rooted <- function(phy) { if (!inherits(phy, "phylo")) - stop('object "phy" is not of class "phylo"') + stop('object "phy" is not of class "phylo"') if (!is.null(phy$root.edge)) TRUE else - if (tabulate(phy$edge[, 1])[length(phy$tip.label) + 1] > 2) - FALSE else TRUE + if (tabulate(phy$edge[, 1])[length(phy$tip.label) + 1] > 2) + FALSE else TRUE } unroot <- function(phy) { if (!inherits(phy, "phylo")) - stop('object "phy" is not of class "phylo"') + stop('object "phy" is not of class "phylo"') if (dim(phy$edge)[1] < 3) - stop("cannot unroot a tree with two edges.") + stop("cannot unroot a tree with less than three edges.") ## delete FIRST the root.edge (in case this is sufficient to ## unroot the tree, i.e. there is a multichotomy at the root) if (!is.null(phy$root.edge)) phy$root.edge <- NULL @@ -61,13 +61,18 @@ unroot <- function(phy) phy } -root <- function(phy, outgroup, node = NULL, resolve.root = FALSE) +root <- function(phy, outgroup, node = NULL, + resolve.root = FALSE, interactive = FALSE) { if (!inherits(phy, "phylo")) - stop('object "phy" is not of class "phylo"') + stop('object "phy" is not of class "phylo"') phy <- reorder(phy) n <- length(phy$tip.label) - ROOT <- n + 1 + ROOT <- n + 1L + if (interactive) { + node <- identify(phy)$nodes + cat("You have set resolve.root =", resolve.root, "\n") + } if (!is.null(node)) { if (node <= n) stop("incorrect node#: should be greater than the number of taxa") diff --git a/R/rtree.R b/R/rtree.R index 030b47e..46f9abd 100644 --- a/R/rtree.R +++ b/R/rtree.R @@ -1,8 +1,8 @@ -## rtree.R (2009-11-03) +## rtree.R (2010-03-09) -## Generates Random Trees +## Generates Trees -## Copyright 2004-2009 Emmanuel Paradis +## Copyright 2004-2010 Emmanuel Paradis ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. @@ -153,3 +153,60 @@ rmtree <- function(N, n, rooted = TRUE, tip.label = NULL, br = runif, ...) class(a) <- "multiPhylo" a } + +stree <- function(n, type = "star", tip.label = NULL) +{ + type <- match.arg(type, c("star", "balanced", "left", "right")) + n <- as.integer(n) + if (type == "star") { + N <- n + m <- 1L + } else { + m <- n - 1L + N <- n + m - 1L + } + edge <- matrix(0L, N, 2) + + switch(type, "star" = { + edge[, 1] <- n + 1L + edge[, 2] <- 1:n + }, "balanced" = { + if (log2(n) %% 1) + stop("'n' is not a power of 2: cannot make a balanced tree") + foo <- function(node, size) { + if (size == 2) { + edge[c(i, i + 1L), 1L] <<- node + edge[c(i, i + 1L), 2L] <<- c(nexttip, nexttip + 1L) + nexttip <<- nexttip + 2L + i <<- i + 2L + } else { + for (k in 1:2) { # do the 2 subclades + edge[i, ] <<- c(node, nextnode) + nextnode <<- nextnode + 1L + i <<- i + 1L + foo(nextnode - 1L, size/2) + } + } + } + i <- 1L + nexttip <- 1L + nextnode <- n + 2L + foo(n + 1L, n) + }, "left" = { + edge[c(seq.int(from = 1, to = N - 1, by = 2), N), 2L] <- 1:n + nodes <- (n + 1L):(n + m) + edge[seq.int(from = 2, to = N - 1, by = 2), 2L] <- nodes[-1] + edge[, 1L] <- rep(nodes, each = 2) + }, "right" = { + nodes <- (n + 1L):(n + m) + edge[, 1L] <- c(nodes, rev(nodes)) + edge[, 2L] <- c(nodes[-1], 1:n) + }) + + if (is.null(tip.label)) + tip.label <- paste("t", 1:n, sep = "") + phy <- list(edge = edge, tip.label = tip.label, Nnode = m) + class(phy) <- "phylo" + attr(phy, "order" <- "cladewise") + phy +} diff --git a/man/drop.tip.Rd b/man/drop.tip.Rd index 0b2c32a..9317977 100644 --- a/man/drop.tip.Rd +++ b/man/drop.tip.Rd @@ -2,10 +2,17 @@ \alias{drop.tip} \alias{extract.clade} \title{Remove Tips in a Phylogenetic Tree} +\description{ + \code{drop.tip} removes the terminal branches of a phylogenetic tree, + possibly removing the corresponding internal branches. + + \code{extract.clade} does the inverse operation: it keeps all the tips + from a given node, and deletes all the other tips. +} \usage{ drop.tip(phy, tip, trim.internal = TRUE, subtree = FALSE, - root.edge = 0, rooted = is.rooted(phy)) -extract.clade(phy, node, root.edge = 0) + root.edge = 0, rooted = is.rooted(phy), interactive = FALSE) +extract.clade(phy, node, root.edge = 0, interactive = FALSE) } \arguments{ \item{phy}{an object of class \code{"phylo"}.} @@ -18,17 +25,12 @@ extract.clade(phy, node, root.edge = 0) \item{root.edge}{an integer giving the number of internal branches to be used to build the new root edge. This has no effect if \code{trim.internal = FALSE}.} - \item{rooted}{a logical indicated whether the tree must be treated as + \item{rooted}{a logical indicating whether the tree must be treated as rooted or not. This allows to force the tree to be considered as unrooted (see examples).} \item{node}{a node number or label.} -} -\description{ - \code{drop.tip} removes the terminal branches of a phylogenetic tree, - possibly removing the corresponding internal branches. - - \code{extract.clade} does the inverse operation: it keeps all the tips - from a given node, and deletes all the other tips. + \item{interactive}{if \code{TRUE} the user is asked to select the tips + or the node by clicking on the tree which must be plotted.} } \details{ The argument \code{tip} can be either character or numeric. In the diff --git a/man/makeLabel.Rd b/man/makeLabel.Rd index 939e4de..ebaed90 100644 --- a/man/makeLabel.Rd +++ b/man/makeLabel.Rd @@ -57,10 +57,10 @@ makeLabel(x, ...) \value{ An object of the appropriate class. } -\author{Emmanuel Paradis \email{Emmanuel.Paradis@mpl.ird.fr}} +\author{Emmanuel Paradis} \seealso{ \code{\link{makeNodeLabel}}, \code{\link[base]{make.unique}}, - \code{\link[base]{make.names}}, code{\link[base]{abbreviate}} + \code{\link[base]{make.names}}, \code{\link[base]{abbreviate}} } \examples{ x <- rep("a", 3) diff --git a/man/parafit.Rd b/man/parafit.Rd index 0d74006..6cb16ac 100644 --- a/man/parafit.Rd +++ b/man/parafit.Rd @@ -11,16 +11,16 @@ Function \code{\link{parafit}} tests the hypothesis of coevolution between a cla The method, which is described in detail in Legendre et al. (2002), requires some estimates of the phylogenetic trees or phylogenetic distances, and also a description of the host-parasite associations (H-P links) observed in nature. } \usage{ -parafit(host.D, para.D ,HP ,nperm=999, test.links=FALSE, seed=NULL, +parafit(host.D, para.D ,HP ,nperm=999, test.links=FALSE, seed=NULL, correction="none", silent=FALSE) } \arguments{ - \item{host.D }{ A matrix of phylogenetic or patristic distances among the hosts. A matrix of patristic distances exactly represents the information in a phylogenetic tree. } - \item{para.D }{ A matrix of phylogenetic or patristic distances among the parasites. A matrix of patristic distances exactly represents the information in a phylogenetic tree. } + \item{host.D }{ A matrix of phylogenetic or patristic distances among the hosts (object class: \code{matrix}, \code{data.frame} or \code{dist}). A matrix of patristic distances exactly represents the information in a phylogenetic tree. } + \item{para.D }{ A matrix of phylogenetic or patristic distances among the parasites (object class: \code{matrix}, \code{data.frame} or \code{dist}). A matrix of patristic distances exactly represents the information in a phylogenetic tree. } \item{HP }{ A rectangular matrix with hosts as rows and parasites as columns. The matrix contains 1's when a host-parasite link has been observed in nature between the host in the row and the parasite in the column, and 0's otherwise. } \item{nperm}{ Number of permutations for the tests. If \code{nperm = - 0}, permutation tests will not be computed. The default value is \code{nperm = 999}. For large data files, the permutation test is rather slow since the permutation procedure is not compiled. } + 0}, permutation tests will not be computed. The default value is \code{nperm = 999}. For large data files, the permutation test is rather slow since the permutation procedure is not compiled. } \item{test.links }{ \code{test.links = TRUE} will test the significance of individual host-parasite links. Default: \code{test.links = FALSE}. } \item{seed }{ \code{seed = NULL} (default): a seed is chosen at random by the function. That seed is used as the starting point for all tests of significance, i.e. the global H-P test and the tests of individual H-P links if they are requested. Users can select a seed of their choice by giving any integer value to \code{seed}, for example \code{seed = -123456}. Running the function again with the same seed value will produce the exact same test results. } \item{correction}{ Correction methods for negative eigenvalues (details below): \code{correction="lingoes"} and \code{correction="cailliez"}. Default value: \code{"none"}. } @@ -30,7 +30,7 @@ correction="none", silent=FALSE) \details{ Two types of test are produced by the program: a global test of coevolution and, optionally, a test on the individual host-parasite (H-P) link. -The function computes principal coordinates for the host and the parasite distance matrices. The principal coordinates (all of them) act as a complete representation of either the phylogenetic distance matrix or the phylogenetic tree. +The function computes principal coordinates for the host and the parasite distance matrices. The principal coordinates (all of them) act as a complete representation of either the phylogenetic distance matrix or the phylogenetic tree. Phylogenetic distance matrices are normally Euclidean. Patristic distance matrices are additive, thus they are metric and Euclidean. Euclidean matrices are fully represented by real-valued principal coordinate axes. For non-Euclidean matrices, negative eigenvalues are produced; complex principal coordinate axes are associated with the negative eigenvalues. So, the program rejects matrices that are not Euclidean and stops. @@ -43,11 +43,11 @@ The test of each individual H-P link is carried out as follows (H0: this particu The \code{print.parafit} function prints out the results of the global test and, optionally, the results of the tests of the individual host-parasite links. } -\value{ +\value{ \item{ParaFitGlobal }{The statistic of the global H-P test. } - \item{p.global }{The permutational p-value associated with the ParaFitGlobal statistic. } - \item{link.table }{The results of the tests of individual H-P links, including the ParaFitLink1 and ParaFitLink2 statistics and the p-values obtained from their respective permutational tests. } + \item{p.global }{The permutational p-value associated with the ParaFitGlobal statistic. } + \item{link.table }{The results of the tests of individual H-P links, including the ParaFitLink1 and ParaFitLink2 statistics and the p-values obtained from their respective permutational tests. } \item{para.per.host }{Number of parasites per host. } \item{host.per.para }{Number of hosts per parasite. } \item{nperm }{Number of permutations for the tests. } @@ -58,7 +58,7 @@ The \code{print.parafit} function prints out the results of the global test and, \references{ Hafner, M. S, P. D. Sudman, F. X. Villablanca, T. A. Spradling, J. W. Demastes and S. A. Nadler. 1994. Disparate rates of molecular evolution in cospeciating hosts and parasites. \emph{Science}, \bold{265}, 1087--1090. -Legendre, P., Y. Desdevises and E. Bazin. 2002. A statistical test for host-parasite coevolution. \emph{Systematic Biology}, \bold{51}, 217--234. +Legendre, P., Y. Desdevises and E. Bazin. 2002. A statistical test for host-parasite coevolution. \emph{Systematic Biology}, \bold{51(2)}, 217--234. } \seealso{\code{\link{pcoa}} } diff --git a/man/print.phylo.Rd b/man/print.phylo.Rd index 0a78b96..779f3f1 100644 --- a/man/print.phylo.Rd +++ b/man/print.phylo.Rd @@ -26,15 +26,15 @@ \item{\dots}{further arguments passed to or from other methods.} } \description{ - These functions prints a compact summary of a phylogeny, or a list of, - on the console. + 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. + \code{"multiPhylo"} (\code{[}), or NULL. } \author{Ben Bolker \email{bolker@zoo.ufl.edu} and Emmanuel Paradis \email{Emmanuel.Paradis@mpl.ird.fr}} diff --git a/man/read.dna.Rd b/man/read.dna.Rd index f2f2cff..3d4d33b 100644 --- a/man/read.dna.Rd +++ b/man/read.dna.Rd @@ -46,7 +46,7 @@ read.dna(file, format = "interleaved", skip = 0, sequential formats, see below). The names of the sequences are read in the file unless the `seq.names' option is used. Particularities for each format are detailed below. - + \itemize{ \item{Interleaved:}{the function starts to read the sequences when it finds 10 contiguous characters belonging to the ambiguity code of diff --git a/man/root.Rd b/man/root.Rd index 35295b8..f721c04 100644 --- a/man/root.Rd +++ b/man/root.Rd @@ -4,7 +4,7 @@ \alias{is.rooted} \title{Roots Phylogenetic Trees} \usage{ -root(phy, outgroup, node = NULL, resolve.root = FALSE) +root(phy, outgroup, node = NULL, resolve.root = FALSE, interactive = FALSE) unroot(phy) is.rooted(phy) } @@ -15,6 +15,8 @@ is.rooted(phy) \item{node}{alternatively, a node number where to root the tree.} \item{resolve.root}{a logical specifying whether to resolve the new root as a bifurcating node.} + \item{interactive}{if \code{TRUE} the user is asked to select the node + by clicking on the tree which must be plotted.} } \description{ \code{root} reroots a phylogenetic tree with respect to the specified diff --git a/man/rtree.Rd b/man/rtree.Rd index 5f6a7fd..05a1fbe 100644 --- a/man/rtree.Rd +++ b/man/rtree.Rd @@ -44,7 +44,10 @@ rmtree(N, n, rooted = TRUE, tip.label = NULL, br = runif, ...) An object of class \code{"phylo"} or of class \code{"multiPhylo"} in the case of \code{rmtree}. } -\author{Emmanuel Paradis \email{Emmanuel.Paradis@mpl.ird.fr}} +\author{Emmanuel Paradis} +\seealso{ + \code{\link{stree}} +} \examples{ layout(matrix(1:9, 3, 3)) ### Nine random trees: