R/ltt.plot.R

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