X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=R%2Fltt.plot.R;h=a7eae04323169877a30c86b15984fa2256936e77;hb=0875d81d5ba5e6dfe79d42c21b0284b674c73949;hp=17f7497914763f795719b2073cc5fabaf7ee0a91;hpb=c827059eeafc8cbe41c812b26979543ab287803e;p=ape.git diff --git a/R/ltt.plot.R b/R/ltt.plot.R index 17f7497..a7eae04 100644 --- a/R/ltt.plot.R +++ b/R/ltt.plot.R @@ -1,43 +1,49 @@ -## ltt.plot.R (2007-12-22) +## ltt.plot.R (2009-05-10) ## Lineages Through Time Plot -## Copyright 2002-2007 Emmanuel Paradis +## Copyright 2002-2009 Emmanuel Paradis ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. ltt.plot <- function(phy, xlab = "Time", ylab = "N", ...) { - if (class(phy) != "phylo") stop('object "phy" is not of class "phylo"') + if (!inherits(phy, "phylo")) stop('object "phy" is not of class "phylo"') + if (!is.binary.tree(phy)) phy <- multi2di(phy) time <- sort(branching.times(phy), decreasing = TRUE) N <- 1:(length(time) + 1) - plot(-c(time, 0), N, xlab = xlab, ylab = ylab, - xaxs = "r", yaxs = "r", type = "S", ...) + plot.default(-c(time, 0), N, xlab = xlab, ylab = ylab, + xaxs = "r", yaxs = "r", type = "S", ...) } ltt.lines <- function(phy, ...) { + if (!is.binary.tree(phy)) phy <- multi2di(phy) time <- sort(branching.times(phy), decreasing = TRUE) N <- 1:(length(time) + 1) lines(-c(time, 0), N, type = "S", ...) } mltt.plot <- function(phy, ..., dcol = TRUE, dlty = FALSE, legend = TRUE, - xlab = "Time", ylab = "N") + xlab = "Time", ylab = "N", log = "") { ltt.xy <- function(phy) { + if (!is.binary.tree(phy)) phy <- multi2di(phy) x <- -c(sort(branching.times(phy), decreasing = TRUE), 0) names(x) <- NULL y <- 1:length(x) cbind(x, y) } - if (class(phy) == "phylo") { + if (inherits(phy, "phylo")) { # if a tree of class "phylo" TREES <- list(ltt.xy(phy)) names(TREES) <- deparse(substitute(phy)) } else { # a list of trees TREES <- lapply(phy, ltt.xy) names(TREES) <- names(phy) + if (is.null(names(TREES))) + names(TREES) <- + paste(deparse(substitute(phy)), "-", 1:length(TREES)) } dts <- list(...) n <- length(dts) @@ -51,6 +57,9 @@ mltt.plot <- function(phy, ..., dcol = TRUE, dlty = FALSE, legend = TRUE, } else { # a list of trees a <- lapply(dts[[i]], ltt.xy) names(a) <- names(dts[[i]]) + if (is.null(names(a))) + names(a) <- + paste(deparse(substitute(phy)), "-", 1:length(a)) } TREES <- c(TREES, a) } @@ -59,8 +68,8 @@ mltt.plot <- function(phy, ..., dcol = TRUE, dlty = FALSE, legend = TRUE, xl <- c(min(unlist(lapply(TREES, function(x) min(x[, 1])))), 0) yl <- c(1, max(unlist(lapply(TREES, function(x) max(x[, 2]))))) - plot(0, 0, type = "n", xlim = xl, ylim = yl, xaxs = "r", yaxs = "r", - xlab = xlab, ylab = ylab) + plot.default(1, 1, type = "n", xlim = xl, ylim = yl, xaxs = "r", + yaxs = "r", xlab = xlab, ylab = ylab, log = log) lty <- if (!dlty) rep(1, n) else 1:n col <- if (!dcol) rep(1, n) else topo.colors(n)