-## scales.R (2008-02-08)
+## scales.R (2011-05-31)
## Add a Scale Bar or Axis to a Phylogeny Plot
## add.scale.bar: add a scale bar to a phylogeny plot
## axisPhylo: add a scale axis on the side of a phylogeny plot
-## Copyright 2002-2008 Emmanuel Paradis
+## Copyright 2002-2011 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
-add.scale.bar <- function(x = 0, y = 1, length = NULL, ...)
+add.scale.bar <- function(x, y, length = NULL, ask = FALSE,
+ lwd = 1, lcol = "black", ...)
{
+ lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
+ direc <- lastPP$direction
if (is.null(length)) {
- nb.digit <- ceiling(log10(mean(get("last_plot.phylo$xx",
- envir = .PlotPhyloEnv)))) - 2
+ nb.digit <-
+ if (direc %in% c("rightwards", "leftwards")) diff(range(lastPP$xx))
+ else diff(range(lastPP$yy))
+ nb.digit <- ceiling(log10(nb.digit)) - 2
length <- eval(parse(text = paste("1e", nb.digit, sep = "")))
}
- segments(x, y, x + length, y)
- text(x + length * 1.1, y, as.character(length), adj = c(0, 0.5), ...)
+
+ if (ask) {
+ cat("\nClick where you want to draw the bar\n")
+ x <- unlist(locator(1))
+ y <- x[2]
+ x <- x[1]
+ } else if (missing(x) || missing(y)) {
+ if (lastPP$type %in% c("phylogram", "cladogram")) {
+ switch(direc,
+ "rightwards" = {
+ x <- 0
+ y <- 1
+ },
+ "leftwards" = {
+ x <- max(lastPP$xx)
+ y <- 1
+ },
+ "upwards" = {
+ x <- max(lastPP$xx)
+ y <- 0
+ },
+ "downwards" = {
+ x <- 1
+ y <- max(lastPP$yy)
+ })
+ } else {
+ direc <- "rightwards" # just to be sure for below
+ x <- lastPP$x.lim[1]
+ y <- lastPP$y.lim[1]
+ }
+ }
+
+ switch(direc,
+ "rightwards" = {
+ segments(x, y, x + length, y, col = lcol, lwd = lwd)
+ text(x + length * 1.1, y, as.character(length), adj = c(0, 0.5), ...)
+ },
+ "leftwards" = {
+ segments(x - length, y, x, y, col = lcol, lwd = lwd)
+ text(x - length * 1.1, y, as.character(length), adj = c(1, 0.5), ...)
+ },
+ "upwards" = {
+ segments(x, y, x, y + length, col = lcol, lwd = lwd)
+ text(x, y + length * 1.1, as.character(length), adj = c(0, 0.5), srt = 90, ...)
+ },
+ "downwards" = {
+ segments(x, y - length, x, y, col = lcol, lwd = lwd)
+ text(x, y - length * 1.1, as.character(length), adj = c(0, 0.5), srt = 270, ...)
+ })
}
axisPhylo <- function(side = 1, ...)
{
- type <- get("last_plot.phylo$type", envir = .PlotPhyloEnv)
- direction <- get("last_plot.phylo$direction", envir = .PlotPhyloEnv)
- if (type %in% c("phylogram", "cladogram")) {
- if (direction %in% c("rightwards", "leftwards")) {
- xx <- get("last_plot.phylo$xx", envir = .PlotPhyloEnv)
- x <- pretty(xx)
- if (direction == "rightwards") maxi <- max(xx)
+ lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
+ if (lastPP$type %in% c("phylogram", "cladogram")) {
+ if (lastPP$direction %in% c("rightwards", "leftwards")) {
+ x <- pretty(lastPP$xx)
+ if (lastPP$direction == "rightwards") maxi <- max(lastPP$xx)
else {
- maxi <- min(xx)
+ maxi <- min(lastPP$xx)
x <- -x
}
} else {
- yy <- get("last_plot.phylo$yy", envir = .PlotPhyloEnv)
- x <- pretty(yy)
- if (direction == "upwards") maxi <- max(yy)
+ x <- pretty(lastPP$yy)
+ if (lastPP$direction == "upwards") maxi <- max(lastPP$yy)
else {
- maxi <- min(yy)
+ maxi <- min(lastPP$yy)
x <- -x
}
}