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

diff --git a/ChangeLog b/ChangeLog
index 5c63f09fb345086f5d30be9816528d1f2259bd3e..4f860f9260e7a1a132c40f8bc280b3a6174ae14c 100644 (file)
--- 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 4c52a3089356d8e94e9dbde5b1a23d4d39874010..fbcf72e3ab28d401dc2d77b8fd2ff2344be8a865 100644 (file)
--- 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 <Emmanuel.Paradis@ird.fr>

diff --git a/R/nodelabels.R b/R/nodelabels.R
index 43ffb93a55da2db56eb8c037b84a4f6d5c3ffc4d..019563dbdcaa492e2397e2c1777a3beec97633c3 100644 (file)
--- 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 4ee98b654f3cf4fe19544439c2dba81c7ab0aa96..eb3ad5c098d536da2ce0e174928b26aa7a9f7061 100644 (file)
--- 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 be732b66f55540b644f3cac7ee60c851b2b42ea0..56c4da1169096cf429200e6bf95afff18771afd2 100644 (file)
--- 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.}