R/ltt.plot.R

   1 ## ltt.plot.R (2007-12-22)
   2
   3 ##    Lineages Through Time Plot
   4
   5 ## Copyright 2002-2007 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(-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")
  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     }
  42     dts <- list(...)
  43     n <- length(dts)
  44     if (n) {
  45         mc <- as.character(match.call())[-(1:2)]
  46         nms <- mc[1:n]
  47         for (i in 1:n) {
  48             if (class(dts[[i]]) == "phylo") {
  49                 a <- list(ltt.xy(dts[[i]]))
  50                 names(a) <- nms[i]
  51             } else { # a list of trees
  52                 a <- lapply(dts[[i]], ltt.xy)
  53                 names(a) <- names(dts[[i]])
  54             }
  55             TREES <- c(TREES, a)
  56         }
  57     }
  58     n <- length(TREES)
  59     xl <- c(min(unlist(lapply(TREES, function(x) min(x[, 1])))), 0)
  60     yl <- c(1, max(unlist(lapply(TREES, function(x) max(x[, 2])))))
  61
  62     plot(0, 0, type = "n", xlim = xl, ylim = yl, xaxs = "r", yaxs = "r",
  63          xlab = xlab, ylab = ylab)
  64
  65     lty <- if (!dlty) rep(1, n) else 1:n
  66     col <- if (!dcol) rep(1, n) else topo.colors(n)
  67
  68     for (i in 1:n)
  69       lines(TREES[[i]], col = col[i], lty = lty[i], type = "S")
  70
  71     if (legend)
  72       legend(xl[1], yl[2], legend = names(TREES),
  73              lty = lty, col = col, bty = "n")
  74 }