From 438bbfbfd282046d154aab68dc5304ffbe94f4d1 Mon Sep 17 00:00:00 2001 From: paradis Date: Mon, 23 Mar 2009 12:48:07 +0000 Subject: [PATCH] adding contribs by Daniel Lawson git-svn-id: https://svn.mpl.ird.fr/ape/dev/ape@67 6e262413-ae40-0410-9e79-b911bd7a66b7 --- ChangeLog | 3 ++ DESCRIPTION | 26 +++++++++++---- R/read.tree.R | 23 +++++++++++--- R/write.tree.R | 80 ++++++++++++++++++++++++++--------------------- man/read.tree.Rd | 25 ++++++++++----- man/write.tree.Rd | 15 +++++++-- 6 files changed, 115 insertions(+), 57 deletions(-) diff --git a/ChangeLog b/ChangeLog index d659113..34d2b12 100644 --- a/ChangeLog +++ b/ChangeLog @@ -13,6 +13,9 @@ NEW FEATURES o The new function makeNodeLabel creates and/or modifies node labels in a flexible way. + o read.tree() and write.tree() have been modified so that they can + handle individual tree names + BUG FIXES diff --git a/DESCRIPTION b/DESCRIPTION index 51c4cfc..94a1c6f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,12 +1,26 @@ Package: ape Version: 2.3 -Date: 2009-03-22 +Date: 2009-03-23 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, Vincent Lefort, Pierre Legendre, - Jim Lemon, Yvonnick Noel, Johan Nylander, Rainer Opgen-Rhein, - Korbinian Strimmer, Damien de Vienne +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 Depends: R (>= 2.6.0) Suggests: gee diff --git a/R/read.tree.R b/R/read.tree.R index cbcfd3f..aa508b0 100644 --- a/R/read.tree.R +++ b/R/read.tree.R @@ -1,8 +1,8 @@ -## read.tree.R (2008-02-18) +## read.tree.R (2009-03-09) ## Read Tree Files in Parenthetic Format -## Copyright 2002-2008 Emmanuel Paradis +## Copyright 2002-2009 Emmanuel Paradis and Daniel Lawson ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. @@ -94,9 +94,18 @@ tree.build <- function(tp) obj } -read.tree <- function(file = "", text = NULL, tree.names = NULL, - skip = 0, comment.char = "#", ...) +read.tree <- function(file = "", text = NULL, tree.names = NULL, skip = 0, + comment.char = "#", keep.multi = FALSE, ...) { + unname <- function(treetext) { + tstart <- 1 + while (substr(treetext, tstart, tstart) != "(" && tstart <= nchar(treetext)) + tstart <- tstart + 1 + if (tstart > 1) + return(c(substr(treetext, 1, tstart - 1), + substr(treetext, tstart, nchar(treetext)))) + return(c("", treetext)) + } if (!is.null(text)) { if (!is.character(text)) stop("argument `text' must be of mode character") @@ -105,6 +114,10 @@ read.tree <- function(file = "", text = NULL, tree.names = NULL, tree <- scan(file = file, what = "", sep = "\n", quiet = TRUE, skip = skip, comment.char = comment.char, ...) } + tmp <- lapply(tree, unname) + tmpnames <- sapply(tmp, function(x) x[1]) + tree <- sapply(tmp, function(x) x[2]) + if (is.null(tree.names) && any(nzchar(tmpnames))) tree.names <- tmpnames ## Suggestion from Eric Durand and Nicolas Bortolussi (added 2005-08-17): if (identical(tree, character(0))) { warning("empty character string.") @@ -139,7 +152,7 @@ read.tree <- function(file = "", text = NULL, tree.names = NULL, if(sum(obj[[i]]$edge[, 1] == ROOT) == 1 && dim(obj[[i]]$edge)[1] > 1) stop(paste("There is apparently two root edges in your file: cannot read tree file.\n Reading Newick file aborted at tree no.", i, sep = "")) } - if (Ntree == 1) obj <- obj[[1]] else { + if (Ntree == 1 && !keep.multi) obj <- obj[[1]] else { if (!is.null(tree.names)) names(obj) <- tree.names class(obj) <- "multiPhylo" } diff --git a/R/write.tree.R b/R/write.tree.R index e4614d8..6bb4f82 100644 --- a/R/write.tree.R +++ b/R/write.tree.R @@ -1,8 +1,8 @@ -## write.tree.R (2007-12-22) +## write.tree.R (2009-03-23) ## Write Tree File in Parenthetic Format -## Copyright 2002-2007 Emmanuel Paradis +## Copyright 2002-2009 Emmanuel Paradis and Daniel Lawson ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. @@ -27,53 +27,52 @@ checkLabel <- function(x, ...) x } -write.tree <- function(phy, file = "", append = FALSE, - digits = 10) +write.tree <- + function (phy, file = "", append = FALSE, digits = 10, 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 + } + if (output.tree.names) + names(tree) <- checkLabel(names(tree)) if (class(phy) == "multiPhylo") { - write.tree(phy[[1]], file = file, - append = append, digits = digits) + write.tree(phy[[1]], file = file, append = append, + digits = digits, tree.names = names[1]) if (length(phy) > 1) - for (i in 2:length(phy)) - write.tree(phy[[i]], file = file, - append = TRUE, digits = digits) + for (i in 2:length(phy)) write.tree(phy[[i]], file = file, + append = TRUE, digits = digits, tree.names = names(phy)[i]) return(invisible(NULL)) } - if (class(phy) != "phylo") - stop('object "phy" is not of class "phylo"') - + stop("object \"phy\" is not of class \"phylo\"") brl <- !is.null(phy$edge.length) - -### Ne serait-il pas plus efficace de créer des node labels vides -### "" et d'éviter l'évaluation if (nodelab) ???? -### Autre possibilité : créer plusieurs variants de ces fonctions -### (au moins deux avec/sans edge.length) - -### Encore autre chose: les appels à which ne peuvent-ils pas -### être évités ??? surtout si l'arbre est en cladewise order... - nodelab <- !is.null(phy$node.label) phy$tip.label <- checkLabel(phy$tip.label) - if (nodelab) - phy$node.label <- checkLabel(phy$node.label) - + if (nodelab) phy$node.label <- checkLabel(phy$node.label) f.d <- paste("%.", digits, "g", sep = "") - cp <- function(s) STRING <<- paste(STRING, s, sep = "") add.internal <- function(i) { cp("(") br <- which(phy$edge[, 1] == i) for (j in br) { desc <- phy$edge[j, 2] - if (desc > n) add.internal(desc) else add.terminal(j) - if (j != br[length(br)]) cp(",") + if (desc > n) + add.internal(desc) + else add.terminal(j) + if (j != br[length(br)]) + cp(",") } cp(")") - if (nodelab) cp(phy$node.label[i - n]) + if (nodelab) + cp(phy$node.label[i - n]) if (brl) { cp(":") - cp(sprintf(f.d, phy$edge.length[which(phy$edge[, 2] == i)])) + cp(sprintf(f.d, phy$edge.length[which(phy$edge[, + 2] == i)])) } } add.terminal <- function(i) { @@ -84,24 +83,33 @@ write.tree <- function(phy, file = "", append = FALSE, } } n <- length(phy$tip.label) - STRING <- "(" + if(tree.names){STRING <- paste(tname,"(",sep="") + }else STRING <- "(" br <- which(phy$edge[, 1] == n + 1) for (j in br) { desc <- phy$edge[j, 2] - if (desc > n) add.internal(desc) else add.terminal(j) - if (j != br[length(br)]) cp(",") + if (desc > n) + add.internal(desc) + else add.terminal(j) + if (j != br[length(br)]) + cp(",") } if (is.null(phy$root.edge)) { cp(")") - if (nodelab) cp(phy$node.label[1]) + if (nodelab) + cp(phy$node.label[1]) cp(";") - } else { + } + else { cp(")") - if (nodelab) cp(phy$node.label[1]) + if (nodelab) + cp(phy$node.label[1]) cp(":") cp(sprintf(f.d, phy$root.edge)) cp(";") } - if (file == "") return(STRING) + if (file == "") + return(STRING) else cat(STRING, file = file, append = append, sep = "\n") } + diff --git a/man/read.tree.Rd b/man/read.tree.Rd index 9428c1e..8ad6ed4 100644 --- a/man/read.tree.Rd +++ b/man/read.tree.Rd @@ -2,8 +2,8 @@ \alias{read.tree} \title{Read Tree File in Parenthetic Format} \usage{ -read.tree(file = "", text = NULL, tree.names = NULL, - skip = 0, comment.char = "#", ...) +read.tree(file = "", text = NULL, tree.names = NULL, skip = 0, + comment.char = "#", keep.multi = FALSE, ...) } \arguments{ \item{file}{a file name specified by either a variable of mode character, @@ -24,7 +24,10 @@ read.tree(file = "", text = NULL, tree.names = NULL, \item{comment.char}{a single character, the remaining of the line after this character is ignored (this is passed directly to \code{scan()}).} - \item{...}{Further arguments to be passed to \code{scan()}.} + \item{keep.multi}{if \code{TRUE} and \code{tree.names = NULL} then + single trees are returned in \code{"multiPhylo"} format, with any + name that is present (see details). Default is \code{FALSE}.} + \item{\dots}{further arguments to be passed to \code{scan()}.} } \description{ This function reads a file which contains one or several trees in @@ -42,6 +45,10 @@ read.tree(file = "", text = NULL, tree.names = NULL, apparently not a valid Newick format. If there are two root edges (e.g., "(((A:1,B:1):10):10);"), then the tree is not read and an error message is issued. + + If there are any characters preceding the first "(" in a line then + this is assigned to the name. This is returned when a "multiphylo" + object is returned and \code{tree.names = NULL}. } \value{ an object of class \code{"phylo"} with the following components: @@ -63,6 +70,8 @@ read.tree(file = "", text = NULL, tree.names = NULL, If several trees are read in the file, the returned object is of class \code{"multiPhylo"}, and is a list of objects of class \code{"phylo"}. + The name of each tree can be specified by \code{tree.names}, or can be + read from the file (see details). } \references{ Felsenstein, J. The Newick tree format. @@ -75,7 +84,8 @@ read.tree(file = "", text = NULL, tree.names = NULL, in R. \url{http://ape.mpl.ird.fr/misc/FormatTreeR_28July2008.pdf} } -\author{Emmanuel Paradis \email{Emmanuel.Paradis@mpl.ird.fr}} +\author{Emmanuel Paradis \email{Emmanuel.Paradis@mpl.ird.fr} and Daniel + Lawson \email{dan.lawson@bristol.ac.uk}} \seealso{ \code{\link{write.tree}}, \code{\link{read.nexus}}, \code{\link{write.nexus}}, \code{\link[base]{scan}} for the basic R @@ -83,12 +93,13 @@ read.tree(file = "", text = NULL, tree.names = NULL, } \examples{ ### An extract from Sibley and Ahlquist (1990) -cat("(((Strix_aluco:4.2,Asio_otus:4.2):3.1,", - "Athene_noctua:7.3):6.3,Tyto_alba:13.5);", - file = "ex.tre", sep = "\n") +cat("owls(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);", file = "ex.tre", sep = "\n") tree.owls <- read.tree("ex.tre") str(tree.owls) tree.owls +tree.owls <- read.tree("ex.tre", keep.multi = TRUE) +tree.owls +names(tree.owls) unlink("ex.tre") # delete the file "ex.tre" ### Only the first three species using the option `text' TREE <- "((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3);" diff --git a/man/write.tree.Rd b/man/write.tree.Rd index d184456..70e1967 100644 --- a/man/write.tree.Rd +++ b/man/write.tree.Rd @@ -3,7 +3,7 @@ \title{Write Tree File in Parenthetic Format} \usage{ write.tree(phy, file = "", append = FALSE, - digits = 10) + digits = 10, tree.names = FALSE) } \arguments{ \item{phy}{an object of class \code{"phylo"}.} @@ -15,6 +15,10 @@ write.tree(phy, file = "", append = FALSE, the file (if it exists) is overwritten (\code{FALSE} the default).} \item{digits}{a numeric giving the number of digits used for printing branch lengths.} + \item{tree.names}{either a logical or a vector of mode character. If + \code{TRUE} then any tree names will be written prior to the tree on + each line. If character, specifies the name of \code{"phylo"} + objects which can be written to the file.} } \description{ This function writes in a file a tree in parenthetic format using the @@ -27,6 +31,10 @@ write.tree(phy, file = "", append = FALSE, \details{ The node labels and the root edge length, if available, are written in the file. + + If \code{tree.names == TRUE} then a variant of the Newick format is + written for which the name of a tree precedes the Newick format tree + (parentheses are eventually deleted beforehand). } \references{ Felsenstein, J. The Newick tree format. @@ -36,10 +44,11 @@ write.tree(phy, file = "", append = FALSE, \url{http://evolution.genetics.washington.edu/phylip/newick_doc.html} } -\author{Emmanuel Paradis \email{Emmanuel.Paradis@mpl.ird.fr}} +\author{Emmanuel Paradis \email{Emmanuel.Paradis@mpl.ird.fr} and Daniel + Lawson \email{dan.lawson@bristol.ac.uk}} \seealso{ \code{\link{read.tree}}, \code{\link{read.nexus}}, \code{\link{write.nexus}} } \keyword{manip} -\keyword{IO} +\keyword{IO} \ No newline at end of file -- 2.39.2