R/scales.R

   1 ## scales.R (2009-12-16)
   2
   3 ##   Add a Scale Bar or Axis to a Phylogeny Plot
   4
   5 ## add.scale.bar: add a scale bar to a phylogeny plot
   6 ## axisPhylo: add a scale axis on the side of a phylogeny plot
   7
   8 ## Copyright 2002-2009 Emmanuel Paradis
   9
  10 ## This file is part of the R-package `ape'.
  11 ## See the file ../COPYING for licensing issues.
  12
  13 add.scale.bar <- function(x, y, length = NULL, ask = FALSE, ...)
  14 {
  15     lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
  16     direc <- lastPP$direction
  17     if (is.null(length)) {
  18         nb.digit <-
  19           if (direc %in% c("rightwards", "leftwards")) diff(range(lastPP$xx))
  20           else diff(range(lastPP$yy))
  21         nb.digit <- ceiling(log10(nb.digit)) - 2
  22         length <- eval(parse(text = paste("1e", nb.digit, sep = "")))
  23     }
  24
  25     if (ask) {
  26         cat("\nClick where you want to draw the bar\n")
  27         x <- unlist(locator(1))
  28         y <- x[2]
  29         x <- x[1]
  30     } else if (missing(x) || missing(y)) {
  31         if (lastPP$type %in% c("phylogram", "cladogram")) {
  32             switch(direc,
  33                    "rightwards" = {
  34                        x <- 0
  35                        y <- 1
  36                    },
  37                    "leftwards" = {
  38                        x <- max(lastPP$xx)
  39                        y <- 1
  40                    },
  41                    "upwards" = {
  42                        x <- max(lastPP$xx)
  43                        y <- 0
  44                    },
  45                    "downwards" = {
  46                        x <- 1
  47                        y <- max(lastPP$yy)
  48                    })
  49         } else {
  50             direc <- "rightwards" # just to be sure for below
  51             x <- lastPP$x.lim[1]
  52             y <- lastPP$y.lim[1]
  53         }
  54     }
  55
  56     switch(direc,
  57            "rightwards" = {
  58                segments(x, y, x + length, y)
  59                text(x + length * 1.1, y, as.character(length), adj = c(0, 0.5), ...)
  60            },
  61            "leftwards" = {
  62                segments(x - length, y, x, y)
  63                text(x - length * 1.1, y, as.character(length), adj = c(1, 0.5), ...)
  64            },
  65            "upwards" = {
  66                segments(x, y, x, y + length)
  67                text(x, y + length * 1.1, as.character(length), adj = c(0, 0.5), srt = 90, ...)
  68            },
  69            "downwards" = {
  70                segments(x, y - length, x, y)
  71                text(x, y - length * 1.1, as.character(length), adj = c(0, 0.5), srt = 270, ...)
  72            })
  73 }
  74
  75 axisPhylo <- function(side = 1, ...)
  76 {
  77     lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
  78     if (lastPP$type %in% c("phylogram", "cladogram")) {
  79         if (lastPP$direction %in% c("rightwards", "leftwards")) {
  80             x <- pretty(lastPP$xx)
  81             if (lastPP$direction == "rightwards") maxi <- max(lastPP$xx)
  82             else {
  83                 maxi <- min(lastPP$xx)
  84                 x <- -x
  85             }
  86         } else {
  87             x <- pretty(lastPP$yy)
  88             if (lastPP$direction == "upwards") maxi <- max(lastPP$yy)
  89             else {
  90                 maxi <- min(lastPP$yy)
  91                 x <- -x
  92             }
  93         }
  94     }
  95     axis(side = side, at = c(maxi - x), labels = abs(x), ...)
  96 }