From e35b97276d72cdfce0697be85668b12194ae65d7 Mon Sep 17 00:00:00 2001 From: Klaus Schliep Date: Thu, 14 Nov 2024 21:08:21 +0100 Subject: [PATCH] improve plots, use improvements to ape --- R/Densi.R | 48 ++++++++++++++++++++---------------------------- R/joint_ASR.R | 3 ++- R/plot_pml.R | 35 ++++++++++++++++++++++++++--------- man/plot.pml.Rd | 16 ++++++++++++---- 4 files changed, 60 insertions(+), 42 deletions(-) diff --git a/R/Densi.R b/R/Densi.R index 31176b5c..a2c1c79c 100644 --- a/R/Densi.R +++ b/R/Densi.R @@ -145,6 +145,9 @@ densiTree <- function(x, type = "phylogram", ..., alpha = 1 / length(x), } if (inherits(consensus, "multiPhylo")) consensus <- consensus[[1]] + extras <- match.call(expand.dots = FALSE)$... + cex.axis <- ifelse(is.null(extras$cex.axis), cex, extras$cex.axis) + sort_tips <- function(x) { x <- reorder(x) nTip <- as.integer(length(x$tip.label)) @@ -163,24 +166,25 @@ densiTree <- function(x, type = "phylogram", ..., alpha = 1 / length(x), nTip <- as.integer(length(consensus$tip.label)) consensus <- sort_tips(consensus) consensus <- reorder(consensus, "postorder") - at <- NULL +# at <- NULL maxBT <- max(getAges(x)) + root_time <- NULL if(!is.null(tip.dates)){ root_time <- max(tip.dates) - maxBT label <- pretty(c(root_time, max(tip.dates)), min.n = 3) label <- label[label < max(tip.dates)] maxBT <- max(maxBT, max(tip.dates) - min(label)) - at <- maxBT - (max(tip.dates) - label) #/ maxBT - if(direction=="leftwards" || direction=="downwards") { - at <- at + maxBT - max(at) - } +# at <- maxBT - (max(tip.dates) - label) #/ maxBT +# if(direction=="leftwards" || direction=="downwards") { +# at <- at + maxBT - max(at) +# } scaleX <- FALSE } else { if (scaleX) maxBT <- 1.0 label <- rev(pretty(c(maxBT, 0))) maxBT <- max(label, maxBT) - at <- seq(0, maxBT, length.out = length(label)) +# at <- seq(0, maxBT, length.out = length(label)) } xy <- plotPhyloCoor(consensus, direction = direction, ...) yy <- xy[, 2] @@ -202,26 +206,8 @@ densiTree <- function(x, type = "phylogram", ..., alpha = 1 / length(x), downwards = c(0 - sw, maxBT), upwards = c(0, maxBT + sw)) } - if (direction == "rightwards") { - plot.default(0, type = "n", xlim = xlim, ylim = ylim, - xlab = "", ylab = "", axes = FALSE, ...) - if (scale.bar) axis(side = 1, at = at, labels = label, cex.axis=cex) - } - if (direction == "leftwards") { - plot.default(0, type = "n", xlim = xlim, ylim = ylim, - xlab = "", ylab = "", axes = FALSE, ...) - if (scale.bar) axis(side = 1, at = at, labels = rev(label), cex.axis=cex) - } - if (direction == "downwards") { - plot.default(0, type = "n", xlim = xlim, ylim = ylim, - xlab = "", ylab = "", axes = FALSE, ...) - if (scale.bar) axis(side = 2, at = at, labels = rev(label), cex.axis=cex) - } - if (direction == "upwards") { - plot.default(0, type = "n", xlim = xlim, ylim = ylim, - xlab = "", ylab = "", axes = FALSE, ...) - if (scale.bar) axis(side = 2, at = at, labels = label, cex.axis=cex) - } + plot.default(0, type = "n", xlim = xlim, ylim = ylim, + xlab = "", ylab = "", axes = FALSE, ...) tip_labels <- consensus$tip.label if (is.expression(consensus$tip.label)) underscore <- TRUE @@ -239,6 +225,9 @@ densiTree <- function(x, type = "phylogram", ..., alpha = 1 / length(x), else jit <- seq(-jitter$amount, jitter$amount, length = length(x)) } + + range_x <- range_y <- NULL + for (treeindex in seq_along(x)) { tmp <- reorder(x[[treeindex]]) @@ -247,7 +236,6 @@ densiTree <- function(x, type = "phylogram", ..., alpha = 1 / length(x), xy <- plotPhyloCoor(tmp, tip.height = tiporder, direction = direction, ...) xx <- xy[, 1] yy <- xy[, 2] - if (horizontal) { if (scaleX) xx <- xx / max(xx) else xx <- xx #/ maxBT @@ -260,6 +248,8 @@ densiTree <- function(x, type = "phylogram", ..., alpha = 1 / length(x), if (direction == "upwards") yy <- yy + (maxBT - max(yy)) if (jitter$amount > 0) xx <- xx + jit[treeindex] } + range_x <- c(min(range_x[1], min(xx)), max(range_x[2], max(xx))) + range_y <- c(min(range_y[1], min(yy)), max(range_y[2], max(yy))) e1 <- tmp$edge[, 1] if (type == "cladogram") cladogram.plot(tmp$edge, xx, yy, edge.color = adjustcolor(col[treeindex], alpha.f = alpha), edge.width = width, @@ -274,9 +264,11 @@ densiTree <- function(x, type = "phylogram", ..., alpha = 1 / length(x), } L <- list(type = type, font = font, cex = cex, adj = adj, srt = srt, #no.margin = no.margin, - label.offset = label.offset, + label.offset = label.offset, xx=range_x, yy=range_y, x.lim = xlim, y.lim = ylim, direction = direction, tip.color = tip.color, Ntip = nTip) assign("last_plot.phylo", L, envir = .PlotPhyloEnv) + if (scale.bar) axisPhylo(root.time = root_time, backward=is.null(root_time), + cex.axis=cex.axis) invisible(x) } diff --git a/R/joint_ASR.R b/R/joint_ASR.R index c41dd4fd..cac60932 100644 --- a/R/joint_ASR.R +++ b/R/joint_ASR.R @@ -143,9 +143,10 @@ joint_sankoff <- function(tree, data, cost=NULL){ count_mutations <- function(tree, data){ site <- "pscore" tree <- reorder(tree, "postorder") + data <- data[tree$tip.label] tree_tmp <- makeNodeLabel(tree) anc <- joint_sankoff(tree_tmp, data) - dat <- rbind(data, anc)[c(tree_tmp$tip.label, tree_tmp$node.label)] + dat <- rbind(data, anc) nr <- attr(data, "nr") l <- length(dat) fun <- function(x, site="pscore", nr){ diff --git a/R/plot_pml.R b/R/plot_pml.R index 14b0330b..8350bb92 100644 --- a/R/plot_pml.R +++ b/R/plot_pml.R @@ -3,16 +3,20 @@ #' \code{plot.pml} is a wrapper around \code{plot.phylo} with different default #' values for unrooted, ultrametric and tip dated phylogenies. #' -#' @param x an object of class \code{pml} or \code{phyDat}. +#' @param x an object of class \code{pml}. #' @param type a character string specifying the type of phylogeny to be drawn; #' it must be one of "phylogram" (the default), "cladogram", "fan", "unrooted", #' "radial", "tidy", or any unambiguous abbreviation of these. #' @param direction a character string specifying the direction of the tree. #' Four values are possible: "rightwards" (the default), "leftwards", "upwards", #' and "downwards". +#' @param adj one or two numeric values specifying the horizontal and vertical +#' justification of the text or symbols of the support values. +#' @param method either "FBP" the classical bootstrap (default), "TBE" +#' (transfer bootstrap) or "MCC" for assigning clade credibilities. +#' @param digits integer indicating the number of decimal places. #' @param \dots further parameters to be passed to \code{plot.phylo}. -#' @return \code{plot.pml} returns invisibly a list with arguments dexcribing -#' the plot. For further details see the \code{plot.phylo}. +#' @return \code{plot.pml} returns the \code{pml} object x. #' @author Klaus Schliep \email{klaus.schliep@@gmail.com} #' @seealso \code{\link[ape]{plot.phylo}}, \code{\link[ape]{axisPhylo}}, #' \code{\link[ape]{add.scale.bar}} @@ -37,7 +41,8 @@ #' plot(fit_unrooted, cex=.5) #' #' @export -plot.pml <- function(x, type="phylogram", direction = "rightwards", ...){ +plot.pml <- function(x, type="phylogram", direction = "rightwards", + ..., adj = NULL, digits=2, method="FBP"){ type <- match.arg(type, c("phylogram","cladogram", "fan", "unrooted", "radial", "tidy")) tree <- x$tree @@ -50,8 +55,8 @@ plot.pml <- function(x, type="phylogram", direction = "rightwards", ...){ direction <- match.arg(direction, c("rightwards", "leftwards", "upwards", "downwards")) side <- switch(direction, - rightwards = 1, - leftwards = 1, + "rightwards" = 1, + "leftwards" = 1, "upwards" = 2, "downwards" = 2) if(!is.null(x$tip.dates) && x$method=="tipdated"){ @@ -62,8 +67,20 @@ plot.pml <- function(x, type="phylogram", direction = "rightwards", ...){ else if(!is.null(x$method) && x$method=="ultrametric") axisPhylo(side, cex.axis=cex.axis) else add.scale.bar(cex=cex) + if(!is.null(x$bs)) { + if(is.null(adj)){ + adj <- c(0.5, 0) + if(side==2) adj <- c(1, 0.5) + } + add_support(tree, x$bs, cex=cex, adj=adj, method=method, digits=digits) + } + } + else{ + add.scale.bar(cex=cex) + if(!is.null(x$bs)) { + if(is.null(adj)) adj <- c(0.5, 0.5) + add_support(tree, x$bs, cex=cex, adj=adj, method=method, digits=digits) + } } - else add.scale.bar(cex=cex) - if(!is.null(x$bs)) add_support(tree, x$bs, cex=cex) - invisible(L) + invisible(x) } diff --git a/man/plot.pml.Rd b/man/plot.pml.Rd index 5091e1fe..a574ec50 100644 --- a/man/plot.pml.Rd +++ b/man/plot.pml.Rd @@ -4,10 +4,11 @@ \alias{plot.pml} \title{Plot phylogeny of a pml object} \usage{ -\method{plot}{pml}(x, type = "phylogram", direction = "rightwards", ...) +\method{plot}{pml}(x, type = "phylogram", direction = "rightwards", ..., + adj = NULL, digits = 2, method = "FBP") } \arguments{ -\item{x}{an object of class \code{pml} or \code{phyDat}.} +\item{x}{an object of class \code{pml}.} \item{type}{a character string specifying the type of phylogeny to be drawn; it must be one of "phylogram" (the default), "cladogram", "fan", "unrooted", @@ -18,10 +19,17 @@ Four values are possible: "rightwards" (the default), "leftwards", "upwards", and "downwards".} \item{\dots}{further parameters to be passed to \code{plot.phylo}.} + +\item{adj}{one or two numeric values specifying the horizontal and vertical +justification of the text or symbols of the support values.} + +\item{digits}{integer indicating the number of decimal places.} + +\item{method}{either "FBP" the classical bootstrap (default), "TBE" +(transfer bootstrap) or "MCC" for assigning clade credibilities.} } \value{ -\code{plot.pml} returns invisibly a list with arguments dexcribing -the plot. For further details see the \code{plot.phylo}. +\code{plot.pml} returns the \code{pml} object x. } \description{ \code{plot.pml} is a wrapper around \code{plot.phylo} with different default