R/ltt.plot.R

   1 ## ltt.plot.R (2008-02-22)
   2
   3 ##    Lineages Through Time Plot
   4
   5 ## Copyright 2002-2008 Emmanuel Paradis
   6
   7 ## This file is part of the R-package `ape'.
   8 ## See the file ../COPYING for licensing issues.
   9
  10 ltt.plot <- function(phy, xlab = "Time", ylab = "N", ...)
  11 {
  12     if (class(phy) != "phylo") stop('object "phy" is not of class "phylo"')
  13     time <- sort(branching.times(phy), decreasing = TRUE)
  14     N <- 1:(length(time) + 1)
  15     plot.default(-c(time, 0), N, xlab = xlab, ylab = ylab,
  16                  xaxs = "r", yaxs = "r", type = "S", ...)
  17 }
  18
  19 ltt.lines <- function(phy, ...)
  20 {
  21     time <- sort(branching.times(phy), decreasing = TRUE)
  22     N <- 1:(length(time) + 1)
  23     lines(-c(time, 0), N, type = "S", ...)
  24 }
  25
  26 mltt.plot <- function(phy, ..., dcol = TRUE, dlty = FALSE, legend = TRUE,
  27                       xlab = "Time", ylab = "N", log = "")
  28 {
  29     ltt.xy <- function(phy) {
  30         x <- -c(sort(branching.times(phy), decreasing = TRUE), 0)
  31         names(x) <- NULL
  32         y <- 1:length(x)
  33         cbind(x, y)
  34     }
  35     if (class(phy) == "phylo") {
  36         TREES <- list(ltt.xy(phy))
  37         names(TREES) <- deparse(substitute(phy))
  38     } else { # a list of trees
  39         TREES <- lapply(phy, ltt.xy)
  40         names(TREES) <- names(phy)
  41         if (is.null(names(TREES)))
  42             names(TREES) <-
  43                 paste(deparse(substitute(phy)), "-", 1:length(TREES))
  44     }
  45     dts <- list(...)
  46     n <- length(dts)
  47     if (n) {
  48         mc <- as.character(match.call())[-(1:2)]
  49         nms <- mc[1:n]
  50         for (i in 1:n) {
  51             if (class(dts[[i]]) == "phylo") {
  52                 a <- list(ltt.xy(dts[[i]]))
  53                 names(a) <- nms[i]
  54             } else { # a list of trees
  55                 a <- lapply(dts[[i]], ltt.xy)
  56                 names(a) <- names(dts[[i]])
  57                 if (is.null(names(a)))
  58                     names(a) <-
  59                         paste(deparse(substitute(phy)), "-", 1:length(a))
  60             }
  61             TREES <- c(TREES, a)
  62         }
  63     }
  64     n <- length(TREES)
  65     xl <- c(min(unlist(lapply(TREES, function(x) min(x[, 1])))), 0)
  66     yl <- c(1, max(unlist(lapply(TREES, function(x) max(x[, 2])))))
  67
  68     plot.default(1, 1, type = "n", xlim = xl, ylim = yl, xaxs = "r",
  69                  yaxs = "r", xlab = xlab, ylab = ylab, log = log)
  70
  71     lty <- if (!dlty) rep(1, n) else 1:n
  72     col <- if (!dcol) rep(1, n) else topo.colors(n)
  73
  74     for (i in 1:n)
  75       lines(TREES[[i]], col = col[i], lty = lty[i], type = "S")
  76
  77     if (legend)
  78       legend(xl[1], yl[2], legend = names(TREES),
  79              lty = lty, col = col, bty = "n")
  80 }