R/scales.R

   1 ## scales.R (2009-10-02)
   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     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 (missing(x) || missing(y))
  26         switch(direc,
  27                "rightwards" = {
  28                    x <- 0
  29                    y <- 1
  30                },
  31                "leftwards" = {
  32                    x <- max(lastPP$xx)
  33                    y <- 1
  34                },
  35                "upwards" = {
  36                    x <- max(lastPP$xx)
  37                    y <- 0
  38                },
  39                "downwards" = {
  40                    x <- 1
  41                    y <- max(lastPP$yy)
  42                })
  43
  44     switch(direc,
  45            "rightwards" = {
  46                segments(x, y, x + length, y)
  47                text(x + length * 1.1, y, as.character(length), adj = c(0, 0.5), ...)
  48            },
  49            "leftwards" = {
  50                segments(x - length, y, x, y)
  51                text(x - length * 1.1, y, as.character(length), adj = c(1, 0.5), ...)
  52            },
  53            "upwards" = {
  54                segments(x, y, x, y + length)
  55                text(x, y + length * 1.1, as.character(length), adj = c(0, 0.5), srt = 90, ...)
  56            },
  57            "downwards" = {
  58                segments(x, y - length, x, y)
  59                text(x, y - length * 1.1, as.character(length), adj = c(0, 0.5), srt = 270, ...)
  60            })
  61 }
  62
  63 axisPhylo <- function(side = 1, ...)
  64 {
  65     lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
  66     if (lastPP$type %in% c("phylogram", "cladogram")) {
  67         if (lastPP$direction %in% c("rightwards", "leftwards")) {
  68             x <- pretty(lastPP$xx)
  69             if (lastPP$direction == "rightwards") maxi <- max(lastPP$xx)
  70             else {
  71                 maxi <- min(lastPP$xx)
  72                 x <- -x
  73             }
  74         } else {
  75             x <- pretty(lastPP$yy)
  76             if (lastPP$direction == "upwards") maxi <- max(lastPP$yy)
  77             else {
  78                 maxi <- min(lastPP$yy)
  79                 x <- -x
  80             }
  81         }
  82     }
  83     axis(side = side, at = c(maxi - x), labels = abs(x), ...)
  84 }