fixing various bugs + news in cophyloplot

[ape.git] / R / plot.phylo.R

diff --git a/R/plot.phylo.R b/R/plot.phylo.R
index eb3ad5c098d536da2ce0e174928b26aa7a9f7061..631fb4dc35029d0b52f94a361cb789cf1a35e0ae 100644 (file)
--- a/R/plot.phylo.R
+++ b/R/plot.phylo.R
@@ -1,8 +1,8 @@
-## plot.phylo.R (2009-09-30)
+## plot.phylo.R (2010-03-19)
 
 ##   Plot Phylogenies
 
-## Copyright 2002-2009 Emmanuel Paradis
+## Copyright 2002-2010 Emmanuel Paradis
 
 ## This file is part of the R-package `ape'.
 ## See the file ../COPYING for licensing issues.
@@ -62,12 +62,12 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
 
     phyloORclado <- type %in% c("phylogram", "cladogram")
     horizontal <- direction %in% c("rightwards", "leftwards")
+    xe <- x$edge # to save
     if (phyloORclado) {
         ## we first compute the y-coordinates of the tips.
         phyOrder <- attr(x, "order")
         ## make sure the tree is in cladewise order:
         if (is.null(phyOrder) || phyOrder != "cladewise") {
-            xe <- x$edge
             x <- reorder(x) # fix from Klaus Schliep (2007-06-16)
             if (!identical(x$edge, xe)) {
                 ## modified from Li-San Wang's fix (2007-01-23):
@@ -198,8 +198,6 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
                     tmp <- if (show.tip.label) max(xx.tips + strWi/alp) else max(xx.tips)
                 }
                 x.lim[2] <- tmp
-                if (direction == "leftwards") xx <- x.lim[2] - xx #max(xx[ROOT] + tmp)
-#                  else max(xx[1:Ntip] + tmp)
             } else x.lim <- c(1, Ntip)
         } else switch(type, "fan" = {
             if (show.tip.label) {
@@ -227,6 +225,8 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
             if (show.tip.label) -1 - max(nchar(x$tip.label) * 0.03 * cex)
             else -1
     }
+    ## mirror the xx:
+    if (phyloORclado && direction == "leftwards") xx <- x.lim[2] - xx
     if (is.null(y.lim)) {
         if (phyloORclado) {
             if (horizontal) y.lim <- c(1, Ntip) else {
@@ -245,7 +245,6 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
                     tmp <- if (show.tip.label) max(yy.tips + strWi/alp) else max(yy.tips)
                 }
                 y.lim[2] <- tmp
-                if (direction == "downwards") yy <- y.lim[2] - yy
             }
         } else switch(type, "fan" = {
             if (show.tip.label) {
@@ -271,6 +270,8 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
         if (type == "radial")
           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 && 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
@@ -332,6 +333,7 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
              "upwards" = segments(xx[ROOT], 0, xx[ROOT], x$root.edge),
              "downwards" = segments(xx[ROOT], yy[ROOT], xx[ROOT], yy[ROOT] + x$root.edge))
     if (show.tip.label) {
+        if (is.expression(x$tip.label)) underscore <- TRUE
         if (!underscore) x$tip.label <- gsub("_", " ", x$tip.label)
 
         if (phyloORclado)
@@ -363,24 +365,17 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
             }
         }
         if (type %in% c("fan", "radial")) {
-            xx.scaled <- xx[1:Ntip]
-            if (type == "fan") { # no need if type == "radial"
-                maxx <- max(abs(xx.scaled))
-                if (maxx > 1) xx.scaled <- xx.scaled/maxx
-            }
-            angle <- acos(xx.scaled)*180/pi
-            s1 <- angle > 90 & yy[1:Ntip] > 0
-            s2 <- angle < 90 & yy[1:Ntip] < 0
-            s3 <- angle > 90 & yy[1:Ntip] < 0
-            angle[s1] <- angle[s1] + 180
-            angle[s2] <- -angle[s2]
-            angle[s3] <- 180 - angle[s3]
+            xx.tips <- xx[1:Ntip]
+            ## using atan2 considerably facilitates things compared to acos...
+            angle <- atan2(yy[1:Ntip], xx.tips)*180/pi
+            s <- xx.tips < 0
+            angle[s] <- angle[s] + 180
             adj <- numeric(Ntip)
-            adj[xx[1:Ntip] < 0] <- 1
+            adj[xx.tips < 0] <- 1
             ## `srt' takes only a single value, so can't vectorize this:
             for (i in 1:Ntip)
-              text(xx[i], yy[i], x$tip.label[i], font = font, cex = cex,
-                   srt = angle[i], adj = adj[i], col = tip.color[i])
+                text(xx[i], yy[i], x$tip.label[i], font = font, cex = cex,
+                     srt = angle[i], adj = adj[i], col = tip.color[i])
         }
     }
     if (show.node.label)
@@ -393,7 +388,7 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
               label.offset = label.offset, x.lim = x.lim, y.lim = y.lim,
               direction = direction, tip.color = tip.color,
               Ntip = Ntip, Nnode = Nnode)
-    assign("last_plot.phylo", c(L, list(edge = x$edge, xx = xx, yy = yy)),
+    assign("last_plot.phylo", c(L, list(edge = xe, xx = xx, yy = yy)),
            envir = .PlotPhyloEnv)
     invisible(L)
 }
@@ -438,7 +433,7 @@ phylogram.plot <- function(edge, Ntip, Nnode, xx, yy, horizontal,
         edge.color <- rep(edge.color, length.out = Nedge)
         edge.width <- rep(edge.width, length.out = Nedge)
         edge.lty <- rep(edge.lty, length.out = Nedge)
-        DF <- data.frame(edge.color, edge.width, edge.lty)
+        DF <- data.frame(edge.color, edge.width, edge.lty, stringsAsFactors = FALSE)
         color.v <- rep("black", Nnode)
         width.v <- rep(1, Nnode)
         lty.v <- rep(1, Nnode)
@@ -590,5 +585,5 @@ plot.multiPhylo <- function(x, layout = 1, ...)
         par(ask = TRUE)
         on.exit(par(ask = FALSE))
     }
-    for (i in x) plot(i, ...)
+    for (i in 1:length(x)) plot(x[[i]], ...)
 }