improve plots, use improvements to ape

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)
 }

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){

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)
 }