a fix in cophyloplot()

[ape.git] / R / scales.R

diff --git a/R/scales.R b/R/scales.R
index 9699b5b165ca81c4922ddfee2f86242c6d6e54d8..7176d1f5c6e19b1ab60ec11ff2633eb1725ec097 100644 (file)
--- a/R/scales.R
+++ b/R/scales.R
@@ -1,42 +1,94 @@
-## scales.R (2004-12-18)
+## 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-2004 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(.last_plot.phylo$xx))) - 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, ...)
 {
-    if (.last_plot.phylo$type %in% c("phylogram", "cladogram")) {
-        if (.last_plot.phylo$direction %in% c("rightwards", "leftwards")) {
-            x <- pretty(.last_plot.phylo$xx)
-            if (.last_plot.phylo$direction == "rightwards")
-              maxi <- max(.last_plot.phylo$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(.last_plot.phylo$xx)
+                maxi <- min(lastPP$xx)
                 x <- -x
             }
         } else {
-            x <- pretty(.last_plot.phylo$yy)
-            if (.last_plot.phylo$direction == "upwards")
-            maxi <- max(.last_plot.phylo$yy)
+            x <- pretty(lastPP$yy)
+            if (lastPP$direction == "upwards") maxi <- max(lastPP$yy)
             else {
-                maxi <- min(.last_plot.phylo$yy)
+                maxi <- min(lastPP$yy)
                 x <- -x
             }
         }