R/scales.R

   1 ## scales.R (2009-07-23)
   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, ...)
  14 {
  15     lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
  16     if (is.null(length)) {
  17         nb.digit <-
  18           if (lastPP$direction %in% c("rightwards", "leftwards")) diff(range(lastPP$xx))
  19           else diff(range(lastPP$yy))
  20         nb.digit <- ceiling(log10(nb.digit)) - 2
  21         length <- eval(parse(text = paste("1e", nb.digit, sep = "")))
  22     }
  23     if (missing(x) || missing(y)) {
  24         switch(lastPP$direction,
  25                "rightwards" = {
  26                    x <- 0
  27                    y <- 1
  28                    segments(x, y, x + length, y)
  29                    text(x + length * 1.1, y, as.character(length), adj = c(0, 0.5), ...)
  30                },
  31                "leftwards" = {
  32                    x <- max(lastPP$xx)
  33                    y <- 1
  34                    segments(x - length, y, x, y)
  35                    text(x - length * 1.1, y, as.character(length), adj = c(1, 0.5), ...)
  36                },
  37                "upwards" = {
  38                    x <- max(lastPP$xx)
  39                    y <- 0
  40                    segments(x, y, x, y + length)
  41                    text(x, y + length * 1.1, as.character(length), adj = c(0, 0.5), srt = 90, ...)
  42                },
  43                "downwards" = {
  44                    x <- 1
  45                    y <- max(lastPP$yy)
  46                    segments(x, y - length, x, y)
  47                    text(x, y - length * 1.1, as.character(length), adj = c(0, 0.5), srt = 270, ...)
  48                }
  49          )
  50     }
  51 }
  52
  53 axisPhylo <- function(side = 1, ...)
  54 {
  55     lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
  56     if (lastPP$type %in% c("phylogram", "cladogram")) {
  57         if (lastPP$direction %in% c("rightwards", "leftwards")) {
  58             x <- pretty(lastPP$xx)
  59             if (lastPP$direction == "rightwards") maxi <- max(lastPP$xx)
  60             else {
  61                 maxi <- min(lastPP$xx)
  62                 x <- -x
  63             }
  64         } else {
  65             x <- pretty(lastPP$yy)
  66             if (lastPP$direction == "upwards") maxi <- max(lastPP$yy)
  67             else {
  68                 maxi <- min(lastPP$yy)
  69                 x <- -x
  70             }
  71         }
  72     }
  73     axis(side = side, at = c(maxi - x), labels = abs(x), ...)
  74 }