From b0d1251527d8dd48ca1703b1cfaf217f413eda0e Mon Sep 17 00:00:00 2001 From: paradis Date: Tue, 2 Apr 2013 10:44:43 +0000 Subject: [PATCH] final commit for ape 3.0-8 git-svn-id: https://svn.mpl.ird.fr/ape/dev/ape@213 6e262413-ae40-0410-9e79-b911bd7a66b7 --- DESCRIPTION | 4 ++-- LICENCE | 16 ---------------- NAMESPACE | 6 ++++-- NEWS | 8 ++++++-- R/ace.R | 6 +++++- R/compar.gee.R | 2 +- R/ewLasso.R | 9 +++++++-- R/read.dna.R | 4 ++-- R/rtree.R | 50 +++++++++++++++++++++++++------------------------- src/ewLasso.c | 16 ++++++++-------- 10 files changed, 60 insertions(+), 61 deletions(-) delete mode 100644 LICENCE diff --git a/DESCRIPTION b/DESCRIPTION index 0eb27c4..26c79f9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,12 +1,12 @@ Package: ape Version: 3.0-8 -Date: 2013-03-30 +Date: 2013-04-02 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 Depends: R (>= 2.6.0) Suggests: gee, expm -Imports: gee, nlme, lattice, expm +Imports: nlme, lattice ZipData: no Description: ape provides functions for reading, writing, plotting, and manipulating phylogenetic trees, analyses of comparative data in a phylogenetic framework, ancestral character analyses, analyses of diversification and macroevolution, computing distances from allelic and nucleotide data, reading and writing nucleotide sequences, and several tools such as Mantel's test, minimum spanning tree, generalized skyline plots, graphical exploration of phylogenetic data (alex, trex, kronoviz), estimation of absolute evolutionary rates and clock-like trees using mean path lengths and penalized likelihood. Phylogeny estimation can be done with the NJ, BIONJ, ME, MVR, SDM, and triangle methods, and several methods handling incomplete distance matrices (NJ*, BIONJ*, MVR*, and the corresponding triangle method). Some functions call external applications (PhyML, Clustal, T-Coffee, Muscle) whose results are returned into R. License: GPL (>= 2) diff --git a/LICENCE b/LICENCE deleted file mode 100644 index 48416cd..0000000 --- a/LICENCE +++ /dev/null @@ -1,16 +0,0 @@ -Licence -======= - -This is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. \ No newline at end of file diff --git a/NAMESPACE b/NAMESPACE index 08f0899..0823833 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,10 +2,9 @@ useDynLib(ape) exportPattern(".+") -import(gee, nlme) +import(nlme) importFrom(lattice, xyplot, panel.lines, panel.points) importFrom(stats, as.hclust, cophenetic, reorder) -importFrom(expm, expm) S3method(print, phylo) S3method(plot, phylo) @@ -25,3 +24,6 @@ S3method("[", DNAbin) S3method(labels, DNAbin) S3method(as.character, DNAbin) S3method(as.matrix, DNAbin) +S3method(c, DNAbin) +S3method(image, DNAbin) +S3method(as.list, DNAbin) diff --git a/NEWS b/NEWS index 4307766..807a2e4 100644 --- a/NEWS +++ b/NEWS @@ -3,7 +3,7 @@ NEW FEATURES - o The new function ewLasso whether tests an incomplete set of + o The new function ewLasso tests whether an incomplete set of distances uniquely determines the edge weights of a given unrooted topology using the 'Lasso' method by Dress et al. (2012, J. Math. Biol. 65:77). @@ -25,6 +25,9 @@ BUG FIXES indicating that no test of significance is computed between a distance matrix and itself. + o rtree(n, rooted = FALSE) returned trees with an 'edge' matrix + stored as doubles instead of integers for n > 4. + OTHER CHANGES @@ -34,7 +37,8 @@ OTHER CHANGES o ace() has a new default for its option 'method': this is "REML" for continuous characters and "ML" for discrete ones. - o ape now imports the package expm so this one must be installed. + o ape does not import gee anymore so the latter doesn't need to + be installed. diff --git a/R/ace.R b/R/ace.R index b751c69..5227e1c 100644 --- a/R/ace.R +++ b/R/ace.R @@ -193,7 +193,11 @@ ace <- liks[cbind(TIPS, x)] <- 1 phy <- reorder(phy, "pruningwise") - E <- if (use.expm) expm::expm else ape::matexpo + ## E <- if (use.expm) expm::expm else ape::matexpo + E <- if (use.expm) { + library(expm) + get("expm", "package:expm") + } else ape::matexpo Q <- matrix(0, nl, nl) dev <- function(p, output.liks = FALSE) { diff --git a/R/compar.gee.R b/R/compar.gee.R index 1df2107..ed84dd5 100644 --- a/R/compar.gee.R +++ b/R/compar.gee.R @@ -11,7 +11,7 @@ compar.gee <- function(formula, data = NULL, family = gaussian, phy, corStruct, scale.fix = FALSE, scale.value = 1) { - require(gee, quietly = TRUE) + library(gee) if (!missing(corStruct)) { if (!missing(phy)) diff --git a/R/ewLasso.R b/R/ewLasso.R index bd8f7fe..ad57eb1 100644 --- a/R/ewLasso.R +++ b/R/ewLasso.R @@ -1,4 +1,4 @@ -## ewLasso.R (2013-03-30) +## ewLasso.R (2013-04-02) ## Lasso Tree @@ -14,10 +14,15 @@ ewLasso <- function(X, phy) X[X < 0] <- -1 X[is.nan(X)] <- -1 + if (is.rooted(phy)) { + phy <- unroot(phy) + warning("'phy' is rooted: it was unrooted for this operation") + } + N <- attr(X, "Size") labels <- attr(X, "Labels") if (is.null(labels)) labels <- as.character(1:N) ans <- .C("ewLasso", as.double(X), as.integer(N), - phy$edge[, 1], phy$edge[, 2], + as.integer(phy$edge[, 1]), as.integer(phy$edge[, 2]), DUP = FALSE, NAOK = TRUE, PACKAGE = "ape") } diff --git a/R/read.dna.R b/R/read.dna.R index fb8b54b..ab8051e 100644 --- a/R/read.dna.R +++ b/R/read.dna.R @@ -1,4 +1,4 @@ -## read.dna.R (2013-01-31) +## read.dna.R (2013-04-02) ## Read DNA Sequences in a File @@ -12,7 +12,7 @@ read.FASTA <- function(file) sz <- file.info(file)$size x <- readBin(file, "raw", sz) icr <- which(x == as.raw(0x0d)) # CR - x <- x[-icr] + if (length(icr)) x <- x[-icr] res <- .Call("rawStreamToDNAbin", x, PACKAGE = "ape") names(res) <- sub("^ +", "", names(res)) # to permit phylosim class(res) <- "DNAbin" diff --git a/R/rtree.R b/R/rtree.R index eb00b60..b36f9d3 100644 --- a/R/rtree.R +++ b/R/rtree.R @@ -1,8 +1,8 @@ -## rtree.R (2012-09-14) +## rtree.R (2013-04-02) ## Generates Trees -## Copyright 2004-2012 Emmanuel Paradis +## Copyright 2004-2013 Emmanuel Paradis ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. @@ -54,39 +54,39 @@ rtree <- function(n, rooted = TRUE, tip.label = NULL, br = runif, ...) i <- which(is.na(edge[, 2])) edge[i, 2] <- 1:n } else { # n > 4 - n1 <- sample.int(n - 2, 1, FALSE, NULL) - if (n1 == n - 2) { - n2 <- n3 <- 1 + n1 <- sample.int(n - 2L, 1L) + if (n1 == n - 2L) { + n2 <- n3 <- 1L } else { - n2 <- sample.int(n - n1 - 1, 1, FALSE, NULL) + n2 <- sample.int(n - n1 - 1L, 1L) n3 <- n - n1 - n2 } - po2 <- 2*n1 - po3 <- 2*(n1 + n2) - 1 - edge[c(1, po2, po3), 1] <- nod - nod <- nod + 1 - if (n1 > 2) { - edge[1, 2] <- nod - foo(n1, 2) - } else if (n1 == 2) { - edge[2:3, 1] <- edge[1, 2] <- nod + po2 <- 2L * n1 + po3 <- 2L * (n1 + n2) - 1L + edge[c(1, po2, po3), 1L] <- nod + nod <- nod + 1L + if (n1 > 2L) { + edge[1L, 2L] <- nod + foo(n1, 2L) + } else if (n1 == 2L) { + edge[2:3, 1L] <- edge[1L, 2L] <- nod nod <- nod + 1L } - if (n2 > 2) { - edge[po2, 2] <- nod - foo(n2, po2 + 1) - } else if (n2 == 2) { - edge[c(po2 + 1, po2 + 2), 1] <- edge[po2, 2] <- nod + if (n2 > 2L) { + edge[po2, 2L] <- nod + foo(n2, po2 + 1L) + } else if (n2 == 2L) { + edge[c(po2 + 1L, po2 + 2), 1L] <- edge[po2, 2L] <- nod nod <- nod + 1L } if (n3 > 2) { - edge[po3, 2] <- nod - foo(n3, po3 + 1) - } else if (n3 == 2) { - edge[c(po3 + 1, po3 + 2), 1] <- edge[po3, 2] <- nod + edge[po3, 2L] <- nod + foo(n3, po3 + 1L) + } else if (n3 == 2L) { + edge[c(po3 + 1L, po3 + 2), 1L] <- edge[po3, 2L] <- nod ## nod <- nod + 1L } - i <- which(is.na(edge[, 2])) + i <- which(is.na(edge[, 2L])) edge[i, 2] <- 1:n } } diff --git a/src/ewLasso.c b/src/ewLasso.c index a59f3c7..dc07b8c 100644 --- a/src/ewLasso.c +++ b/src/ewLasso.c @@ -22,7 +22,7 @@ int isTripletCover(int nmb, int n, int** s, int stat, int sSoFar[n], int* a)//nu { if(!sSoFar[j])continue;//not in set so far if(!a[i*(n+1)+j]){//if not, then i is not a good candidate for this side - //Rprintf("failed to find distance between %i and %i, a[%i][%i]=%i \n",i,j,i,j,a[i*(n+1)+j]); + //Rprintf("failed to find distance between %i and %i, a[%i][%i]=%i \n",i,j,i,j,a[i*(n+1)+j]); sw=0; } } @@ -55,8 +55,8 @@ void ewLasso(double *D, int *N, int *e1, int *e2) { a[i*(n+1)+j]=a[j*(n+1)+i]=0; } - else - { + else + { a[i*(n+1)+j]=a[j*(n+1)+i]=1;// otherwise edge between pair of taxa (i,j) in G } } @@ -85,7 +85,7 @@ void ewLasso(double *D, int *N, int *e1, int *e2) while(comp) { q[p]=ini; - v[ini]=1; + v[ini]=1; comp=0; int stNBipartiteLoc=0;//check if current connected component is bipartite while(p