From: paradis Date: Thu, 27 May 2010 15:25:40 +0000 (+0000) Subject: new mixedFontLabel() + bug fix in rTraitCont.c X-Git-Url: https://git.donarmstrong.com/?p=ape.git;a=commitdiff_plain;h=2419de65ffb4f7c45eb8c2448bcba3d0df64744f new mixedFontLabel() + bug fix in rTraitCont.c git-svn-id: https://svn.mpl.ird.fr/ape/dev/ape@123 6e262413-ae40-0410-9e79-b911bd7a66b7 --- diff --git a/ChangeLog b/ChangeLog index 2ccbdf4..d1862f6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -3,6 +3,9 @@ NEW FEATURES + o The new function mixedFontLabel helps to make labels with bits of + text to be plotted in different fonts. + 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. @@ -19,6 +22,9 @@ 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. + o rTraitCont() did not use the square-root of branch lengths when + simulating a Brownian motion model. + CHANGES IN APE VERSION 2.5-2 diff --git a/DESCRIPTION b/DESCRIPTION index bb68ebf..e775372 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ape Version: 2.5-3 -Date: 2010-05-25 +Date: 2010-05-27 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/R/makeLabel.R b/R/makeLabel.R index e51b654..0ac2e44 100644 --- a/R/makeLabel.R +++ b/R/makeLabel.R @@ -1,8 +1,8 @@ -## makeLabel.R (2008-07-03) +## makeLabel.R (2010-05-27) ## Label Management -## Copyright 2008 Emmanuel Paradis +## Copyright 2010 Emmanuel Paradis ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. @@ -69,3 +69,41 @@ makeLabel.DNAbin <- function(x, ...) else rownames(x) <- makeLabel.character(rownames(x), ...) x } + +mixedFontLabel <- + function(..., sep = " ", italic = NULL, bold = NULL, parenthesis = NULL, + always.upright = c("sp.", "spp.", "ssp.")) +{ + x <- list(...) + n <- length(x) + sep <- rep(sep, length.out = n - 1L) + + if (!is.null(italic)) { + for (i in italic) { + y <- x[[i]] + s <- ! y %in% always.upright + y[s] <- paste("italic('", y[s], "')", sep = "") + x[[i]] <- y + } + } + + if (!is.null(bold)) { + for (i in bold) { + y <- x[[i]] + s <- logical(length(y)) + s[grep("^italic", y)] <- TRUE + y[s] <- sub("^italic", "bolditalic", y[s]) + y[!s] <- paste("bold('", y[!s], "')", sep = "") + x[[i]] <- y + } + } + + if (!is.null(parenthesis)) + for (i in parenthesis) + x[[i]] <- paste("(", x[[i]], ")", sep = "") + + res <- x[[1L]] + for (i in 2:n) + res <- paste(res, "*'", sep[i - 1L], "'*", x[[i]], sep = "") + parse(text = res) +} diff --git a/R/write.tree.R b/R/write.tree.R index 996b9aa..fa82a7b 100644 --- a/R/write.tree.R +++ b/R/write.tree.R @@ -61,19 +61,15 @@ write.tree <- br <- which(phy$edge[, 1] == i) for (j in br) { desc <- phy$edge[j, 2] - if (desc > n) - add.internal(desc) + if (desc > n) add.internal(desc) else add.terminal(j) - if (j != br[length(br)]) - cp(",") + 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) { @@ -89,28 +85,23 @@ write.tree <- br <- which(phy$edge[, 1] == n + 1) for (j in br) { desc <- phy$edge[j, 2] - if (desc > n) - add.internal(desc) + if (desc > n) add.internal(desc) else add.terminal(j) - if (j != br[length(br)]) - cp(",") + 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 { 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) - else cat(STRING, file = file, append = append, sep = "\n") + if (file == "") return(STRING) + cat(STRING, file = file, append = append, sep = "\n") } diff --git a/man/makeLabel.Rd b/man/makeLabel.Rd index ebaed90..be99abd 100644 --- a/man/makeLabel.Rd +++ b/man/makeLabel.Rd @@ -5,6 +5,12 @@ \alias{makeLabel.multiPhylo} \alias{makeLabel.DNAbin} \title{Label Management} +\description{ + This is a generic function with methods for character vectors, trees + of class \code{"phylo"}, lists of trees of class \code{"multiPhylo"}, + and DNA sequences of class \code{"DNAbin"}. All options for the class + character may be used in the other methods. +} \usage{ makeLabel(x, ...) \method{makeLabel}{character}(x, len = 99, space = "_", make.unique = TRUE, @@ -32,12 +38,6 @@ makeLabel(x, ...) modified; \code{TRUE} by default.} \item{\dots}{further arguments to be passed to or from other methods.} } -\description{ - This is a generic function with methods for character vectors, trees - of class \code{"phylo"}, lists of trees of class \code{"multiPhylo"}, - and DNA sequences of class \code{"DNAbin"}. All options for the class - character may be used in the other methods. -} \details{ The option \code{make.unique} does not work exactly in the same way then the function of the same name: numbers are suffixed to all labels @@ -48,7 +48,7 @@ makeLabel(x, ...) on. The number of digits added preserves the option `len'. The default for `len' makes labels short enough to be read by - PHYML. Clustal accepts labels up to 30 character long. + PhyML. Clustal accepts labels up to 30 character long. } \note{ The current version does not perform well when trying to make very @@ -60,7 +60,8 @@ makeLabel(x, ...) \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}}, + \code{\link{mixedFontLabel}} } \examples{ x <- rep("a", 3) diff --git a/man/makeNodeLabel.Rd b/man/makeNodeLabel.Rd index 062b7c8..b48ea13 100644 --- a/man/makeNodeLabel.Rd +++ b/man/makeNodeLabel.Rd @@ -50,7 +50,8 @@ makeNodeLabel(phy, method = "number", prefix = "Node", nodeList = list(), ...) } \author{Emmanuel Paradis \email{Emmanuel.Paradis@mpl.ird.fr}} \seealso{ - \code{\link{makeLabel}}, \code{\link[base]{grep}} + \code{\link{makeLabel}}, \code{\link[base]{grep}}, + \code{\link{mixedFontLabel}} } \examples{ tr <- diff --git a/man/mixedFontLabel.Rd b/man/mixedFontLabel.Rd new file mode 100644 index 0000000..1699715 --- /dev/null +++ b/man/mixedFontLabel.Rd @@ -0,0 +1,63 @@ +\name{mixedFontLabel} +\alias{mixedFontLabel} +\title{Mixed Font Labels for Plotting} +\description{ + This function helps to format labels with bits of text in different + font shapes (italics, bold, or bolditalics) and different + separators. The output is intended to be used for plotting. +} +\usage{ +mixedFontLabel(..., sep = " ", italic = NULL, bold = NULL, + parenthesis = NULL, + always.upright = c("sp.", "spp.", "ssp.")) +} +\arguments{ + \item{\dots}{vectors of mode character to be formatted. They may be + of different lengths in which case the shortest ones are + recycled.} + \item{sep}{a vector of mode character giving the separators to be + printed between the elements in \code{\dots}.} + \item{italic}{a vector of integers specifying the elements in + \code{\dots} to be printed in italics.} + \item{bold}{id. in boldface.} + \item{parenthesis}{id. within parentheses.} + \item{always.upright}{of vector of mode character giving the strings + to not print in italics. Use \code{always.upright = ""} to cancel + this option.} +} +\details{ + The idea is to have different bits of text in different vectors that + are put together to make a vector of R expressions. This vector is + interpreted by graphical functions to format the text. A simple use + may be \code{mixedFontLabel(genus, species), italic = 1:2}, but it is + more interesting when mixing fonts (see examples). + + To have an element in bolditalics, its number must given in both + \code{italic} and \code{bold}. + + The vector returned by this function may be assigned as the + \code{tip.label} element of a tree of class \code{"phylo"}, or even as + its \code{node.label} element. +} +\value{ + A vector of mode expression. +} +\author{Emmanuel Paradis} +\seealso{ + \code{\link{makeLabel}}, \code{\link{makeNodeLabel}} +} +\examples{ +tr <- read.tree(text = "((a,(b,c)),d);") +genus <- c("Gorilla", "Pan", "Homo", "Pongo") +species <- c("gorilla", "spp.", "sapiens", "pygmaeus") +geo <- c("Africa", "Africa", "World", "Asia") +tr$tip.label <- mixedFontLabel(genus, species, geo, italic = 1:2, + parenthesis = 3) +layout(matrix(c(1, 2), 2)) +plot(tr) +tr$tip.label <- mixedFontLabel(genus, species, geo, sep = c(" ", " - "), + italic = 1:2, bold = 3) +plot(tr) +layout(1) +} +\keyword{manip} diff --git a/man/nodelabels.Rd b/man/nodelabels.Rd index 82a3acb..fa81274 100644 --- a/man/nodelabels.Rd +++ b/man/nodelabels.Rd @@ -83,7 +83,8 @@ edgelabels(text, edge, adj = c(0.5, 0.5), frame = "rect", \author{Emmanuel Paradis, Ben Bolker \email{bolker@zoo.ufl.edu}, and Jim Lemon} \seealso{ - \code{\link{plot.phylo}}, \code{\link{edges}} + \code{\link{plot.phylo}}, \code{\link{edges}}, + \code{\link{mixedFontLabel}} } \examples{ tr <- read.tree(text = "((Homo,Pan),Gorilla);") diff --git a/src/rTrait.c b/src/rTrait.c index 6441e16..2e7371f 100644 --- a/src/rTrait.c +++ b/src/rTrait.c @@ -1,4 +1,4 @@ -/* rTrait.c 2010-01-11 */ +/* rTrait.c 2010-05-26 */ /* Copyright 2010 Emmanuel Paradis */ @@ -16,13 +16,13 @@ void rTraitCont(int *model, int *Nedge, int *edge1, int *edge2, double *el, switch(*model) { case 1 : for (i = *Nedge - 1; i >= 0; i--) { GetRNGstate(); - x[edge2[i]] = x[edge1[i]] + el[i] * sigma[i] * norm_rand(); + x[edge2[i]] = x[edge1[i]] + sqrt(el[i]) * sigma[i] * norm_rand(); PutRNGstate(); } break; case 2 : for (i = *Nedge - 1; i >= 0; i--) { GetRNGstate(); - x[edge2[i]] = x[edge1[i]] + (sigma[i]*norm_rand() - alpha[i]*(x[edge1[i]] - theta[i])) * el[i]; + x[edge2[i]] = x[edge1[i]] + (sigma[i]*norm_rand() - alpha[i]*(x[edge1[i]] - theta[i])) * el[i]; /* need sqrt(el[i]) ? */ PutRNGstate(); } break;