X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=R%2Fscales.R;h=c2e9d61cff22ca4c116f69c0d39a66103c0dd02d;hb=a2fc961dffe9f9b7994ed880e68c03b2334dc341;hp=378f985cc4c434e3104c2a3498844aba991540a2;hpb=5de3d16fdc60bcbab2ae04933bca4ab931ed48f8;p=ape.git

diff --git a/R/scales.R b/R/scales.R
index 378f985..c2e9d61 100644
--- a/R/scales.R
+++ b/R/scales.R
@@ -1,16 +1,17 @@
-## scales.R (2009-07-23)
+## scales.R (2012-12-19)
 
 ##   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-2009 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, y, 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
@@ -22,40 +23,52 @@ add.scale.bar <- function(x, y, length = NULL, ...)
         length <- eval(parse(text = paste("1e", nb.digit, sep = "")))
     }
 
-    if (missing(x) || missing(y))
-        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)
-               })
+    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)
+               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)
+               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)
+               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)
+               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, ...)
            })
 }
@@ -63,7 +76,14 @@ add.scale.bar <- function(x, y, length = NULL, ...)
 axisPhylo <- function(side = 1, ...)
 {
     lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
-    if (lastPP$type %in% c("phylogram", "cladogram")) {
+    type <- lastPP$type
+
+    if (type == "unrooted")
+        stop("axisPhylo() not available for unrooted plots; try add.scale.bar()")
+    if (type == "radial")
+        stop("axisPhylo() not meaningful for this type of plot")
+
+    if (type %in% c("phylogram", "cladogram")) {
         if (lastPP$direction %in% c("rightwards", "leftwards")) {
             x <- pretty(lastPP$xx)
             if (lastPP$direction == "rightwards") maxi <- max(lastPP$xx)
@@ -79,6 +99,33 @@ axisPhylo <- function(side = 1, ...)
                 x <- -x
             }
         }
+        axis(side = side, at = c(maxi - x), labels = abs(x), ...)
+    } else { # type == "fan"
+        n <- lastPP$Ntip
+        xx <- lastPP$xx[1:n]; yy <- lastPP$yy[1:n]
+        r0 <- max(sqrt(xx^2 + yy^2))
+        firstandlast <- c(1, n)
+        theta0 <- mean(atan2(yy[firstandlast], xx[firstandlast]))
+        x0 <- r0 * cos(theta0); y0 <- r0 * sin(theta0)
+        inc <- diff(pretty(c(0, r0))[1:2])
+        srt <- 360*theta0/(2*pi)
+        coef <- -1
+        if (abs(srt) > 90) {
+            srt <- srt + 180
+            coef <- 1
+        }
+        len <- 0.025 * r0 # the length of tick marks
+        r <- r0
+        while (r > 1e-8) {
+            x <- r * cos(theta0); y <- r * sin(theta0)
+            if (len/r < 1) {
+                ra <- sqrt(len^2 + r^2); thetaa <- theta0 + coef * asin(len/r)
+                xa <- ra * cos(thetaa); ya <- ra * sin(thetaa)
+                segments(xa, ya, x, y)
+                text(xa, ya, r0 - r, srt = srt, adj = c(0.5, 1.1), ...)
+            }
+            r <- r - inc
+        }
+        segments(x, y, x0, y0)
     }
-    axis(side = side, at = c(maxi - x), labels = abs(x), ...)
 }