From b9f8872e29c6dbda44f60f67b9797dd90a119de6 Mon Sep 17 00:00:00 2001 From: paradis Date: Wed, 30 Sep 2009 08:50:34 +0000 Subject: [PATCH] final plot.phylo and change to BOTHlabels() from Janet Young git-svn-id: https://svn.mpl.ird.fr/ape/dev/ape@93 6e262413-ae40-0410-9e79-b911bd7a66b7 --- ChangeLog | 5 ++- DESCRIPTION | 2 +- R/nodelabels.R | 19 ++++++----- R/plot.phylo.R | 86 ++++++++--------------------------------------- man/nodelabels.Rd | 7 ++-- 5 files changed, 33 insertions(+), 86 deletions(-) diff --git a/ChangeLog b/ChangeLog index 5c63f09..4f860f9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -25,8 +25,11 @@ OTHER CHANGES been modified (as well as their widths and types) following some users' request; this is only for dichotomous nodes. + o The argument 'adj' in [node][tip][edge]labels() now works when + using 'pie' or 'thermo'. + o Deprecated functions are now listed in a help page: see - help("ape-defunct"), with the quotes! + help("ape-defunct") with the quotes. DEPRECATED & DEFUNCT diff --git a/DESCRIPTION b/DESCRIPTION index 4c52a30..fbcf72e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ape Version: 2.4 -Date: 2009-09-23 +Date: 2009-09-30 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/nodelabels.R b/R/nodelabels.R index 43ffb93..019563d 100644 --- a/R/nodelabels.R +++ b/R/nodelabels.R @@ -1,8 +1,8 @@ -## nodelabels.R (2008-02-28) +## nodelabels.R (2009-09-30) ## Labelling Trees -## Copyright 2004-2008 Emmanuel Paradis, 2006 Ben Bolker, and 2006 Jim Lemon +## Copyright 2004-2009 Emmanuel Paradis, 2006 Ben Bolker, and 2006 Jim Lemon ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. @@ -88,16 +88,16 @@ BOTHlabels <- function(text, sel, XX, YY, adj, frame, pch, thermo, height <- CEX * (parusr[4] - parusr[3]) / 15 if (is.vector(thermo)) thermo <- cbind(thermo, 1 - thermo) thermo <- height * thermo - xl <- XX - width/2 + xl <- XX - width/2 + adj[1] - 0.5 # added 'adj' from Janet Young (2009-09-30) xr <- xl + width - yb <- YY - height/2 + yb <- YY - height/2 + adj[2] - 0.5 if (is.null(piecol)) piecol <- rainbow(ncol(thermo)) ## draw the first rectangle: rect(xl, yb, xr, yb + thermo[, 1], border = NA, col = piecol[1]) for (i in 2:ncol(thermo)) - rect(xl, yb + rowSums(thermo[, 1:(i - 1), drop = FALSE]), - xr, yb + rowSums(thermo[, 1:i]), - border = NA, col = piecol[i]) + rect(xl, yb + rowSums(thermo[, 1:(i - 1), drop = FALSE]), + xr, yb + rowSums(thermo[, 1:i]), + border = NA, col = piecol[i]) rect(xl, yb, xr, yb + height, border = "black") segments(xl, YY, xl - width/5, YY) segments(xr, YY, xr + width/5, YY) @@ -107,9 +107,10 @@ BOTHlabels <- function(text, sel, XX, YY, adj, frame, pch, thermo, if (is.vector(pie)) pie <- cbind(pie, 1 - pie) xrad <- CEX * diff(par("usr")[1:2]) / 50 xrad <- rep(xrad, length(sel)) + XX <- XX + adj[1] - 0.5 + YY <- YY + adj[2] - 0.5 for (i in 1:length(sel)) - floating.pie.asp(XX[i], YY[i], pie[i, ], - radius = xrad[i], col = piecol) + 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/plot.phylo.R b/R/plot.phylo.R index 4ee98b6..eb3ad5c 100644 --- a/R/plot.phylo.R +++ b/R/plot.phylo.R @@ -1,4 +1,4 @@ -## plot.phylo.R (2009-09-23) +## plot.phylo.R (2009-09-30) ## Plot Phylogenies @@ -130,8 +130,7 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE, } else { xx <- .nodeDepthEdgelength(Ntip, Nnode, z$edge, Nedge, z$edge.length) } - } - if (type == "fan") { + } else switch(type, "fan" = { ## if the tips are not in the same order in tip.label ## and in edge[, 2], we must reorder the angles: we ## use `xx' to store temporarily the angles @@ -149,9 +148,7 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE, } xx <- r*cos(theta) yy <- r*sin(theta) - - } - if (type == "unrooted") { + }, "unrooted" = { nb.sp <- .nodeDepth(Ntip, Nnode, z$edge, Nedge) XY <- if (use.edge.length) unrooted.xy(Ntip, Nnode, z$edge, z$edge.length, nb.sp) @@ -160,8 +157,7 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE, ## rescale so that we have only positive values xx <- XY$M[, 1] - min(XY$M[, 1]) yy <- XY$M[, 2] - min(XY$M[, 2]) - } - if (type == "radial") { + }, "radial" = { X <- .nodeDepth(Ntip, Nnode, z$edge, Nedge) X[X == 1] <- 0 ## radius: @@ -171,7 +167,7 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE, Y <- .nodeHeight(Ntip, Nnode, z$edge, Nedge, yy) xx <- X * cos(Y) yy <- X * sin(Y) - } + }) if (phyloORclado) { if (!horizontal) { tmp <- yy @@ -205,25 +201,22 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE, if (direction == "leftwards") xx <- x.lim[2] - xx #max(xx[ROOT] + tmp) # else max(xx[1:Ntip] + tmp) } else x.lim <- c(1, Ntip) - } - if (type == "fan") { + } else switch(type, "fan" = { if (show.tip.label) { offset <- max(nchar(x$tip.label) * 0.018 * max(yy) * cex) x.lim <- c(min(xx) - offset, max(xx) + offset) } else x.lim <- c(min(xx), max(xx)) - } - if (type == "unrooted") { + }, "unrooted" = { if (show.tip.label) { offset <- max(nchar(x$tip.label) * 0.018 * max(yy) * cex) x.lim <- c(0 - offset, max(xx) + offset) } else x.lim <- c(0, max(xx)) - } - if (type == "radial") { + }, "radial" = { if (show.tip.label) { offset <- max(nchar(x$tip.label) * 0.03 * cex) x.lim <- c(-1 - offset, 1 + offset) } else x.lim <- c(-1, 1) - } + }) } else if (length(x.lim) == 1) { x.lim <- c(0, x.lim) if (phyloORclado && !horizontal) x.lim[1] <- 1 @@ -254,25 +247,22 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE, y.lim[2] <- tmp if (direction == "downwards") yy <- y.lim[2] - yy } - } - if (type == "fan") { + } else switch(type, "fan" = { if (show.tip.label) { offset <- max(nchar(x$tip.label) * 0.018 * max(yy) * cex) y.lim <- c(min(yy) - offset, max(yy) + offset) } else y.lim <- c(min(yy), max(yy)) - } - if (type == "unrooted") { + }, "unrooted" = { if (show.tip.label) { offset <- max(nchar(x$tip.label) * 0.018 * max(yy) * cex) y.lim <- c(0 - offset, max(yy) + offset) } else y.lim <- c(0, max(yy)) - } - if (type == "radial") { + }, "radial" = { if (show.tip.label) { offset <- max(nchar(x$tip.label) * 0.03 * cex) y.lim <- c(-1 - offset, 1 + offset) } else y.lim <- c(-1, 1) - } + }) } else if (length(y.lim) == 1) { y.lim <- c(0, y.lim) if (phyloORclado && horizontal) y.lim[1] <- 1 @@ -285,8 +275,7 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE, if (direction == "leftwards") x.lim[2] <- x.lim[2] + x$root.edge if (direction == "downwards") y.lim[2] <- y.lim[2] + x$root.edge } - ## fix by Klaus Schliep (2008-03-28): - asp <- if (type %in% c("fan", "radial")) 1 else NA + asp <- if (type %in% c("fan", "radial")) 1 else NA # fix by Klaus Schliep (2008-03-28) plot(0, type = "n", xlim = x.lim, ylim = y.lim, ann = FALSE, axes = FALSE, asp = asp, ...) if (is.null(adj)) adj <- if (phyloORclado && direction == "leftwards") 1 else 0 @@ -432,18 +421,9 @@ phylogram.plot <- function(edge, Ntip, Nnode, xx, yy, horizontal, } ## ... et un trait horizontal partant de chaque tip et chaque noeud ## vers la racine -### sq <- c(1:Ntip, nodes[-1]) -### y0h <- yy[sq] -### x1h <- xx[sq] -### ## match() is very useful here becoz each element in edge[, 2] is -### ## unique (not sure this is so useful in edge[, 1]; needs to be checked) -### ## `pos' gives for each element in `sq' its index in edge[, 2] -### pos <- match(sq, edge[, 2]) -### x0h <- xx[edge[pos, 1]] x0h <- xx[edge[, 1]] x1h <- xx[edge[, 2]] y0h <- yy[edge[, 2]] -### donc plus besoin de 'pos' ni 'sq' nc <- length(edge.color) nw <- length(edge.width) @@ -496,44 +476,6 @@ phylogram.plot <- function(edge, Ntip, Nnode, xx, yy, horizontal, } } -### ## function dispatching the features to the vertical edges -### foo <- function(edge.feat, default) { -### e <- unique(edge.feat) -### if (length(e) == 1) return(rep(e, Nnode)) -### else { -### feat.v <- rep(default, Nnode) -### for (i in 1:Nnode) { -### br <- NodeInEdge1[[i]] -### if (length(br) > 2) { -### x <- unique(edge.feat[br]) -### if (length(x) == 1) feat.v[i] <- x -### } else { -### if (edge.feat[br[1]] == edge.feat[br[2]]) -### feat.v[i] <- edge.feat[br[1]] -### else { -### feat.v[i] <- edge.feat[br[2]] -### ## add a new line: -### y0v <<- c(y0v, y0v[i]) -### y1v <<- c(y1v, yy[i + Ntip]) -### x0v <<- c(x0v, x0v[i]) -### feat.v <- c(feat.v, edge.feat[br[1]]) -### ## shorten the line: -### y0v[i] <<- yy[i + Ntip] -### } -### } -### } -### } -### feat.v -### } -### color.v <- foo(edge.color, "black") -### width.v <- foo(edge.width, 1) -### lty.v <- foo(edge.lty, 1) - -### ## we need to reorder: -### edge.width <- edge.width[pos] -### edge.color <- edge.color[pos] -### edge.lty <- edge.lty[pos] - if (horizontal) { segments(x0h, y0h, x1h, y0h, col = edge.color, lwd = edge.width, lty = edge.lty) # draws horizontal lines segments(x0v, y0v, x0v, y1v, col = color.v, lwd = width.v, lty = lty.v) # draws vertical lines diff --git a/man/nodelabels.Rd b/man/nodelabels.Rd index be732b6..56c4da1 100644 --- a/man/nodelabels.Rd +++ b/man/nodelabels.Rd @@ -30,9 +30,10 @@ edgelabels(text, edge, adj = c(0.5, 0.5), frame = "rect", \item{edge}{a vector of mode numeric giving the numbers of the edges where the text or the symbols are to be printed. Can be left empty.} \item{adj}{one or two numeric values specifying the horizontal and - vertical, respectively, justification of the text. By default, the - text is centered horizontally and vertically. If a single value is - given, this alters only the horizontal position of the text.} + vertical, respectively, justification of the text or symbols. By + default, the text is centered horizontally and vertically. If a + single value is given, this alters only the horizontal position of + the text.} \item{frame}{a character string specifying the kind of frame to be printed around the text. This must be one of "rect" (the default), "circle", "none", or any unambiguous abbreviation of these.} -- 2.39.2