]> git.donarmstrong.com Git - ape.git/blobdiff - R/plot.phylo.R
various bug fixes
[ape.git] / R / plot.phylo.R
index 18bba88509dd0bab1e37b91d3b274c26a6aee316..3fd0637295d84063afd81cbe2bea7d5509bbe7d4 100644 (file)
@@ -1,20 +1,21 @@
-## plot.phylo.R (2011-03-23)
+## plot.phylo.R (2012-03-22)
 
 ##   Plot Phylogenies
 
-## Copyright 2002-2011 Emmanuel Paradis
+## Copyright 2002-2012 Emmanuel Paradis
 
 ## This file is part of the R-package `ape'.
 ## See the file ../COPYING for licensing issues.
 
-plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
-                       node.pos = NULL, show.tip.label = TRUE,
-                       show.node.label = FALSE, edge.color = "black",
-                       edge.width = 1, edge.lty = 1, font = 3, cex = par("cex"),
-                       adj = NULL, srt = 0, no.margin = FALSE,
-                       root.edge = FALSE, label.offset = 0, underscore = FALSE,
-                       x.lim = NULL, y.lim = NULL, direction = "rightwards",
-                       lab4ut = "horizontal", tip.color = "black", ...)
+plot.phylo <-
+    function(x, type = "phylogram", use.edge.length = TRUE,
+             node.pos = NULL, show.tip.label = TRUE,
+             show.node.label = FALSE, edge.color = "black",
+             edge.width = 1, edge.lty = 1, font = 3, cex = par("cex"),
+             adj = NULL, srt = 0, no.margin = FALSE, root.edge = FALSE,
+             label.offset = 0, underscore = FALSE, x.lim = NULL,
+             y.lim = NULL, direction = "rightwards", lab4ut = "horizontal",
+             tip.color = "black", plot = TRUE, rotate.tree = 0, ...)
 {
     Ntip <- length(x$tip.label)
     if (Ntip == 1) {
@@ -95,17 +96,7 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
     }
     ## 'z' is the tree in pruningwise order used in calls to .C
     z <- reorder(x, order = "pruningwise")
-###    edge.color <- rep(edge.color, length.out = Nedge)
-###    edge.width <- rep(edge.width, length.out = Nedge)
-###    edge.lty <- rep(edge.lty, length.out = Nedge)
-###    ## fix from Li-San Wang (2007-01-23):
-###    xe <- x$edge
-###    x <- reorder(x, order = "pruningwise")
-###    ereorder <- match(x$edge[, 2], xe[, 2])
-###    edge.color <- edge.color[ereorder]
-###    edge.width <- edge.width[ereorder]
-###    edge.lty <- edge.lty[ereorder]
-###    ## end of fix
+
     if (phyloORclado) {
         if (is.null(node.pos)) {
             node.pos <- 1
@@ -130,7 +121,9 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
         } else  {
             xx <- .nodeDepthEdgelength(Ntip, Nnode, z$edge, Nedge, z$edge.length)
         }
-    } else switch(type, "fan" = {
+    } else {
+    rotate.tree <- 2 * pi * rotate.tree/360
+    switch(type, "fan" = {
         ## if the tips are not in the same order in tip.label
         ## and in edge[, 2], we must reorder the angles: we
         ## use `xx' to store temporarily the angles
@@ -146,14 +139,15 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
             r <- .nodeDepth(Ntip, Nnode, z$edge, Nedge)
             r <- 1/r
         }
+        theta <- theta + rotate.tree
         xx <- r*cos(theta)
         yy <- r*sin(theta)
     }, "unrooted" = {
         nb.sp <- .nodeDepth(Ntip, Nnode, z$edge, Nedge)
         XY <- if (use.edge.length)
-            unrooted.xy(Ntip, Nnode, z$edge, z$edge.length, nb.sp)
+            unrooted.xy(Ntip, Nnode, z$edge, z$edge.length, nb.sp, rotate.tree)
         else
-            unrooted.xy(Ntip, Nnode, z$edge, rep(1, Nedge), nb.sp)
+            unrooted.xy(Ntip, Nnode, z$edge, rep(1, Nedge), nb.sp, rotate.tree)
         ## rescale so that we have only positive values
         xx <- XY$M[, 1] - min(XY$M[, 1])
         yy <- XY$M[, 2] - min(XY$M[, 2])
@@ -165,9 +159,9 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
         ## angle (1st compute the angles for the tips):
         yy <- c((1:Ntip)*2*pi/Ntip, rep(0, Nnode))
         Y <- .nodeHeight(Ntip, Nnode, z$edge, Nedge, yy)
-        xx <- X * cos(Y)
-        yy <- X * sin(Y)
-    })
+        xx <- X * cos(Y + rotate.tree)
+        yy <- X * sin(Y + rotate.tree)
+    })}
     if (phyloORclado) {
         if (!horizontal) {
             tmp <- yy
@@ -266,18 +260,20 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
         y.lim <- c(0, y.lim)
         if (phyloORclado && horizontal) y.lim[1] <- 1
         if (type %in% c("fan", "unrooted") && show.tip.label)
-          y.lim[1] <- -max(nchar(x$tip.label) * 0.018 * max(yy) * cex)
+            y.lim[1] <- -max(nchar(x$tip.label) * 0.018 * max(yy) * cex)
         if (type == "radial")
-          y.lim[1] <- if (show.tip.label) -1 - max(nchar(x$tip.label) * 0.018 * max(yy) * cex) else -1
+            y.lim[1] <- if (show.tip.label) -1 - max(nchar(x$tip.label) * 0.018 * max(yy) * cex) else -1
     }
     ## mirror the yy:
-    if (phyloORclado && direction == "downwards") yy <- y.lim[2] - yy
+    if (phyloORclado && direction == "downwards") yy <- max(yy) - yy
     if (phyloORclado && root.edge) {
         if (direction == "leftwards") x.lim[2] <- x.lim[2] + x$root.edge
         if (direction == "downwards") y.lim[2] <- y.lim[2] + x$root.edge
     }
     asp <- if (type %in% c("fan", "radial", "unrooted")) 1 else NA # fixes by Klaus Schliep (2008-03-28 and 2010-08-12)
     plot(0, type = "n", xlim = x.lim, ylim = y.lim, ann = FALSE, axes = FALSE, asp = asp, ...)
+
+if (plot) {
     if (is.null(adj))
         adj <- if (phyloORclado && direction == "leftwards") 1 else 0
     if (phyloORclado && show.tip.label) {
@@ -288,7 +284,7 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
         }
         if (direction == "leftwards") {
             lox <- -label.offset - MAXSTRING * 1.05 * (1 - adj)
-            #xx <- xx + MAXSTRING
+            ##xx <- xx + MAXSTRING
         }
         if (!horizontal) {
             psr <- par("usr")
@@ -403,6 +399,7 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
     if (show.node.label)
         text(xx[ROOT:length(xx)] + label.offset, yy[ROOT:length(yy)],
              x$node.label, adj = adj, font = font, srt = srt, cex = cex)
+}
     L <- list(type = type, use.edge.length = use.edge.length,
               node.pos = node.pos, show.tip.label = show.tip.label,
               show.node.label = show.node.label, font = font,
@@ -554,7 +551,7 @@ circular.plot <- function(edge, Ntip, Nnode, xx, yy, theta,
     }
 }
 
-unrooted.xy <- function(Ntip, Nnode, edge, edge.length, nb.sp)
+unrooted.xy <- function(Ntip, Nnode, edge, edge.length, nb.sp, rotate.tree)
 {
     foo <- function(node, ANGLE, AXIS) {
         ind <- which(edge[, 1] == node)
@@ -569,7 +566,7 @@ unrooted.xy <- function(Ntip, Nnode, edge, edge.length, nb.sp)
             yy[sons[i]] <<- h*sin(beta) + yy[node]
         }
         for (i in sons)
-          if (i > Ntip) foo(i, angle[i], axis[i])
+            if (i > Ntip) foo(i, angle[i], axis[i])
     }
     Nedge <- dim(edge)[1]
     yy <- xx <- numeric(Ntip + Nnode)
@@ -577,7 +574,7 @@ unrooted.xy <- function(Ntip, Nnode, edge, edge.length, nb.sp)
     ## `axis': the axis of each branch
     axis <- angle <- numeric(Ntip + Nnode)
     ## start with the root...
-    foo(Ntip + 1L, 2*pi, 0)
+    foo(Ntip + 1L, 2*pi, 0 + rotate.tree)
 
     M <- cbind(xx, yy)
     axe <- axis[1:Ntip] # the axis of the terminal branches (for export)