From: paradis Date: Thu, 22 Nov 2012 07:56:13 +0000 (+0000) Subject: fix in drop.tip() and new option in pic() X-Git-Url: https://git.donarmstrong.com/?p=ape.git;a=commitdiff_plain;h=12b407de3b6d3a160eb2ebd48d005da328735206 fix in drop.tip() and new option in pic() git-svn-id: https://svn.mpl.ird.fr/ape/dev/ape@199 6e262413-ae40-0410-9e79-b911bd7a66b7 --- diff --git a/DESCRIPTION b/DESCRIPTION index 3904cc8..83eab43 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ape -Version: 3.0-6 -Date: 2012-10-20 +Version: 3.0-7 +Date: 2012-11-22 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, Andrei-Alin Popescu, Klaus Schliep, Korbinian Strimmer, Damien de Vienne Maintainer: Emmanuel Paradis diff --git a/NEWS b/NEWS index e90cec1..4425348 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,18 @@ + CHANGES IN APE VERSION 3.0-7 + + +NEW FEATURES + + o pic() gains an option 'rescaled.tree = FALSE' to return the tree + with its branch lengths rescaled for the PICs calculation. + + +BUG FIXES + + o drop.tip() shuffled node labels on some trees. + + + CHANGES IN APE VERSION 3.0-6 @@ -1978,14 +1993,14 @@ BUG FIXES o A bug was fixed in phymltest(): the executable couldn't be found in some cases. - o Three bug have been fixed in ace(): computing the likelihood of + o Three bugs have been fixed in ace(): computing the likelihood of ancestral states of discrete characters failed, custom models did not work, and the function failed with a null gradient (a warning message is now returned; this latter bug was also present in yule.cov() as well and is now fixed). - o pic() hanged out when missing data were present: a message error - is now returned. + o pic() hanged out when missing data were present: an error is now + returned. o A small bug was fixed in dist.dna() where the gamma correction was not always correctly dispatched. @@ -2049,7 +2064,7 @@ NEW FEATURES DNA sequences by specifying model = "raw". o dist.phylo() has a new option `full' to possibly compute the - distances among all tips and nodes of the tree. The default if + distances among all tips and nodes of the tree. The default is `full = FALSE'. diff --git a/R/drop.tip.R b/R/drop.tip.R index a720a7c..f1b413f 100644 --- a/R/drop.tip.R +++ b/R/drop.tip.R @@ -1,4 +1,4 @@ -## drop.tip.R (2012-10-20) +## drop.tip.R (2012-11-22) ## Remove Tips in a Phylogenetic Tree @@ -213,7 +213,7 @@ drop.tip <- ## The block below renumbers the nodes so that they conform ## to the "phylo" format, same as in root() - newNb <- integer(n + phy$Nnode) + newNb <- integer(Ntip + Nnode) newNb[NEWROOT] <- n + 1L sndcol <- phy$edge[, 2] > n ## executed from right to left, so newNb is modified before phy$edge: @@ -221,10 +221,8 @@ drop.tip <- (n + 2):(n + phy$Nnode) phy$edge[, 1] <- newNb[phy$edge[, 1]] storage.mode(phy$edge) <- "integer" - if (!is.null(phy$node.label)) { # update node.label if needed - newNb[is.na(newNb)] <- 0L - phy$node.label <- phy$node.label[order(newNb[newNb > 0])] - } + if (!is.null(phy$node.label)) # update node.label if needed + phy$node.label <- phy$node.label[which(newNb > 0) - Ntip] collapse.singles(phy) } diff --git a/R/pic.R b/R/pic.R index b1cb20b..bc54067 100644 --- a/R/pic.R +++ b/R/pic.R @@ -1,4 +1,4 @@ -## pic.R (2012-09-11) +## pic.R (2012-11-20) ## Phylogenetically Independent Contrasts @@ -7,7 +7,7 @@ ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. -pic <- function(x, phy, scaled = TRUE, var.contrasts = FALSE) +pic <- function(x, phy, scaled = TRUE, var.contrasts = FALSE, rescaled.tree = FALSE) { if (!inherits(phy, "phylo")) stop("object 'phy' is not of class \"phylo\"") @@ -35,10 +35,10 @@ pic <- function(x, phy, scaled = TRUE, var.contrasts = FALSE) warning("the names of argument 'x' and the tip labels of the tree did not match: the former were ignored in the analysis.") } } + ## No need to copy the branch lengths: they are rescaled ## in the C code, so it's important to leave the default ## `DUP = TRUE' of .C. - ans <- .C("pic", as.integer(nb.tip), as.integer(nb.node), as.integer(phy$edge[, 1]), as.integer(phy$edge[, 2]), as.double(phy$edge.length), as.double(phenotype), @@ -46,22 +46,6 @@ pic <- function(x, phy, scaled = TRUE, var.contrasts = FALSE) as.integer(var.contrasts), as.integer(scaled), PACKAGE = "ape") - ## The "old" R code: - ##for (i in seq(from = 1, by = 2, length.out = nb.node)) { - ## j <- i + 1 - ## anc <- phy$edge[i, 1] - ## des1 <- phy$edge[i, 2] - ## des2 <- phy$edge[j, 2] - ## sumbl <- bl[i] + bl[j] - ## ic <- anc - nb.tip - ## contr[ic] <- phenotype[des1] - phenotype[des2] - ## if (scaled) contr[ic] <- contr[ic]/sqrt(sumbl) - ## if (var.contrasts) var.con[ic] <- sumbl - ## phenotype[anc] <- (phenotype[des1]*bl[j] + phenotype[des2]*bl[i])/sumbl - ## k <- which(phy$edge[, 2] == anc) - ## bl[k] <- bl[k] + bl[i]*bl[j]/sumbl - ## - ##} contr <- ans[[7]] lbls <- if (is.null(phy$node.label)) as.character(1:nb.node + nb.tip) @@ -70,6 +54,10 @@ pic <- function(x, phy, scaled = TRUE, var.contrasts = FALSE) contr <- cbind(contr, ans[[8]]) dimnames(contr) <- list(lbls, c("contrasts", "variance")) } else names(contr) <- lbls + if (rescaled.tree) { + phy$edge.length <- ans[[5]] + contr <- list(contr = contr, rescaled.tree = phy) + } contr } diff --git a/R/summary.phylo.R b/R/summary.phylo.R index 715021b..f390b24 100644 --- a/R/summary.phylo.R +++ b/R/summary.phylo.R @@ -85,7 +85,7 @@ print.phylo <- function(x, printlen = 6,...) collapse=", "), ", ...\n", sep = "")) } else print(x$tip.label) if (!is.null(x$node.label)) { - cat("\tNode labels:\n") + cat("Node labels:\n") if (nb.node > printlen) { cat(paste("\t", paste(x$node.label[1:printlen], collapse=", "), ", ...\n", sep = "")) diff --git a/man/pic.Rd b/man/pic.Rd index f0d57da..80a421e 100644 --- a/man/pic.Rd +++ b/man/pic.Rd @@ -2,7 +2,8 @@ \alias{pic} \title{Phylogenetically Independent Contrasts} \usage{ -pic(x, phy, scaled = TRUE, var.contrasts = FALSE) +pic(x, phy, scaled = TRUE, var.contrasts = FALSE, + rescaled.tree = FALSE) } \arguments{ \item{x}{a numeric vector.} @@ -10,7 +11,10 @@ pic(x, phy, scaled = TRUE, var.contrasts = FALSE) \item{scaled}{logical, indicates whether the contrasts should be scaled with their expected variances (default to \code{TRUE}).} \item{var.contrasts}{logical, indicates whether the expected - variances of the contrasts should be returned (default to \code{FALSE}).} + variances of the contrasts should be returned (default to + \code{FALSE}).} + \item{rescaled.tree}{logical, if \code{TRUE} the rescaled tree is + returned together with the main results.} } \description{ Compute the phylogenetically independent contrasts using the method @@ -22,10 +26,9 @@ pic(x, phy, scaled = TRUE, var.contrasts = FALSE) than the tip labels of \code{phy}. The user must be careful here since the function requires that both - series of names perfectly match, so this operation may fail if there - is a typing or syntax error. If both series of names do not match, the - values in the \code{x} are taken to be in the same order than the tip - labels of \code{phy}, and a warning message is issued. + series of names perfectly match. If both series of names do not match, + the values in the \code{x} are taken to be in the same order than the + tip labels of \code{phy}, and a warning message is issued. } \value{ either a vector of phylogenetically independent contrasts (if @@ -34,6 +37,10 @@ pic(x, phy, scaled = TRUE, var.contrasts = FALSE) expected variance in the second column (if \code{var.contrasts = TRUE}). If the tree has node labels, these are used as labels of the returned object. + + If \code{rescaled.tree = TRUE}, a list is returned with two elements + named ``contr'' with the above results and ``rescaled.tree'' with the + tree and its rescaled branch lengths (see Felsenstein 1985). } \references{ Felsenstein, J. (1985) Phylogenies and the comparative method.