X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=R%2Fplot.phylo.R;h=4c23c6f0032361e6c3b6181941cbfd4c83ad3f24;hb=12b407de3b6d3a160eb2ebd48d005da328735206;hp=4ee98b654f3cf4fe19544439c2dba81c7ab0aa96;hpb=42bf3d36a0a2a5edd0071739ad346ae9009abffa;p=ape.git

diff --git a/R/plot.phylo.R b/R/plot.phylo.R
index 4ee98b6..4c23c6f 100644
--- a/R/plot.phylo.R
+++ b/R/plot.phylo.R
@@ -1,24 +1,25 @@
-## plot.phylo.R (2009-09-23)
+## plot.phylo.R (2012-10-20)
 
 ##   Plot Phylogenies
 
-## Copyright 2002-2009 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) {
-        warning("found only one tip in the tree")
+    if (Ntip < 2) {
+        warning("found less than 2 tips in the tree")
         return(NULL)
     }
     if (any(tabulate(x$edge[, 1]) == 1))
@@ -62,12 +63,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):
@@ -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,8 +121,9 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
         } else  {
             xx <- .nodeDepthEdgelength(Ntip, Nnode, z$edge, Nedge, z$edge.length)
         }
-    }
-    if (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
@@ -147,21 +139,19 @@ 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)
-
-    }
-    if (type == "unrooted") {
+    }, "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])
-    }
-    if (type == "radial") {
+    }, "radial" = {
         X <- .nodeDepth(Ntip, Nnode, z$edge, Nedge)
         X[X == 1] <- 0
         ## radius:
@@ -169,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
@@ -202,28 +192,23 @@ 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)
-        }
-        if (type == "fan") {
+        } else switch(type, "fan" = {
             if (show.tip.label) {
                 offset <- max(nchar(x$tip.label) * 0.018 * max(yy) * cex)
                 x.lim <- c(min(xx) - offset, max(xx) + offset)
             } else x.lim <- c(min(xx), max(xx))
-        }
-        if (type == "unrooted") {
+        }, "unrooted" = {
             if (show.tip.label) {
                 offset <- max(nchar(x$tip.label) * 0.018 * max(yy) * cex)
                 x.lim <- c(0 - offset, max(xx) + offset)
             } else x.lim <- c(0, max(xx))
-        }
-        if (type == "radial") {
+        }, "radial" = {
             if (show.tip.label) {
                 offset <- max(nchar(x$tip.label) * 0.03 * cex)
                 x.lim <- c(-1 - offset, 1 + offset)
             } else x.lim <- c(-1, 1)
-        }
+        })
     } else if (length(x.lim) == 1) {
         x.lim <- c(0, x.lim)
         if (phyloORclado && !horizontal) x.lim[1] <- 1
@@ -234,6 +219,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 {
@@ -252,42 +239,41 @@ 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
             }
-        }
-        if (type == "fan") {
+        } else switch(type, "fan" = {
             if (show.tip.label) {
                 offset <- max(nchar(x$tip.label) * 0.018 * max(yy) * cex)
                 y.lim <- c(min(yy) - offset, max(yy) + offset)
             } else y.lim <- c(min(yy), max(yy))
-        }
-        if (type == "unrooted") {
+        }, "unrooted" = {
             if (show.tip.label) {
                 offset <- max(nchar(x$tip.label) * 0.018 * max(yy) * cex)
                 y.lim <- c(0 - offset, max(yy) + offset)
             } else y.lim <- c(0, max(yy))
-        }
-        if (type == "radial") {
+        }, "radial" = {
             if (show.tip.label) {
                 offset <- max(nchar(x$tip.label) * 0.03 * cex)
                 y.lim <- c(-1 - offset, 1 + offset)
             } else y.lim <- c(-1, 1)
-        }
+        })
     } else if (length(y.lim) == 1) {
         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 <- 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
     }
-    ## fix by Klaus Schliep (2008-03-28):
-    asp <- if (type %in% c("fan", "radial")) 1 else NA
+    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) {
@@ -298,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")
@@ -343,6 +329,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)
@@ -360,43 +347,59 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE,
                 y.adj[sel] <- strheight(x$tip.label)[sel] / 2
                 sel <- XY$axe < -pi / 4 & XY$axe > -0.75 * pi
                 y.adj[sel] <- -strheight(x$tip.label)[sel] * 0.75
-                text(xx[1:Ntip] + x.adj*cex, yy[1:Ntip] + y.adj*cex,
+                text(xx[1:Ntip] + x.adj * cex, yy[1:Ntip] + y.adj * cex,
                      x$tip.label, adj = c(adj, 0), font = font,
                      srt = srt, cex = cex, col = tip.color)
             } else { # if lab4ut == "axial"
-                adj <- as.numeric(abs(XY$axe) > pi/2)
-                srt <- 180*XY$axe/pi
-                srt[as.logical(adj)] <- srt[as.logical(adj)] - 180
+                adj <- abs(XY$axe) > pi/2
+                srt <- 180 * XY$axe / pi
+                srt[adj] <- srt[adj] - 180
+                adj <- as.numeric(adj)
+                xx.tips <- xx[1:Ntip]
+                yy.tips <- yy[1:Ntip]
+                if (label.offset) {
+                    xx.tips <- xx.tips + label.offset * cos(XY$axe)
+                    yy.tips <- yy.tips + label.offset * sin(XY$axe)
+                }
                 ## `srt' takes only a single value, so can't vectorize this:
+                ## (and need to 'elongate' these vectors:)
+                font <- rep(font, length.out = Ntip)
+                tip.color <- rep(tip.color, length.out = Ntip)
+                cex <- rep(cex, length.out = Ntip)
                 for (i in 1:Ntip)
-                  text(xx[i], yy[i], cex = cex, x$tip.label[i], adj = adj[i],
-                       font = font, srt = srt[i], col = tip.color[i])
+                    text(xx.tips[i], yy.tips[i], cex = cex[i],
+                         x$tip.label[i], adj = adj[i], font = font[i],
+                         srt = srt[i], col = tip.color[i])
             }
         }
         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
+            xx.tips <- xx[1:Ntip]
+            yy.tips <- yy[1:Ntip]
+            ## using atan2 considerably facilitates things compared to acos...
+            angle <- atan2(yy.tips, xx.tips) # in radians
+            if (label.offset) {
+                xx.tips <- xx.tips + label.offset * cos(angle)
+                yy.tips <- yy.tips + label.offset * sin(angle)
             }
-            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]
-            adj <- numeric(Ntip)
-            adj[xx[1:Ntip] < 0] <- 1
+            s <- xx.tips < 0
+            angle <- angle * 180/pi # switch to degrees
+            angle[s] <- angle[s] + 180
+            adj <- as.numeric(s)
             ## `srt' takes only a single value, so can't vectorize this:
+            ## (and need to 'elongate' these vectors:)
+            font <- rep(font, length.out = Ntip)
+            tip.color <- rep(tip.color, length.out = Ntip)
+            cex <- rep(cex, length.out = Ntip)
             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.tips[i], yy.tips[i], x$tip.label[i], font = font[i],
+                     cex = cex[i], srt = angle[i], adj = adj[i],
+                     col = tip.color[i])
         }
     }
     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)
+        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,
@@ -404,7 +407,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)
 }
@@ -418,7 +421,7 @@ phylogram.plot <- function(edge, Ntip, Nnode, xx, yy, horizontal,
         yy <- xx
         xx <- tmp
     }
-    ## un trait vertical à chaque noeud...
+    ## un trait vertical a chaque noeud...
     x0v <- xx[nodes]
     y0v <- y1v <- numeric(Nnode)
     ## store the index of each node in the 1st column of edge:
@@ -432,18 +435,9 @@ phylogram.plot <- function(edge, Ntip, Nnode, xx, yy, horizontal,
     }
     ## ... et un trait horizontal partant de chaque tip et chaque noeud
     ##  vers la racine
-###    sq <- c(1:Ntip, nodes[-1])
-###    y0h <- yy[sq]
-###    x1h <- xx[sq]
-###    ## match() is very useful here becoz each element in edge[, 2] is
-###    ## unique (not sure this is so useful in edge[, 1]; needs to be checked)
-###    ## `pos' gives for each element in `sq' its index in edge[, 2]
-###    pos <- match(sq, edge[, 2])
-###    x0h <- xx[edge[pos, 1]]
     x0h <- xx[edge[, 1]]
     x1h <- xx[edge[, 2]]
     y0h <- yy[edge[, 2]]
-### donc plus besoin de 'pos' ni 'sq'
 
     nc <- length(edge.color)
     nw <- length(edge.width)
@@ -458,7 +452,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)
@@ -496,44 +490,6 @@ phylogram.plot <- function(edge, Ntip, Nnode, xx, yy, horizontal,
         }
     }
 
-###    ## function dispatching the features to the vertical edges
-###    foo <- function(edge.feat, default) {
-###        e <- unique(edge.feat)
-###        if (length(e) == 1) return(rep(e, Nnode))
-###        else {
-###            feat.v <- rep(default, Nnode)
-###            for (i in 1:Nnode) {
-###                br <- NodeInEdge1[[i]]
-###                if (length(br) > 2) {
-###                    x <- unique(edge.feat[br])
-###                    if (length(x) == 1) feat.v[i] <- x
-###                } else {
-###                    if (edge.feat[br[1]] == edge.feat[br[2]])
-###                        feat.v[i] <- edge.feat[br[1]]
-###                    else {
-###                        feat.v[i] <- edge.feat[br[2]]
-###                        ## add a new line:
-###                        y0v <<- c(y0v, y0v[i])
-###                        y1v <<- c(y1v, yy[i + Ntip])
-###                        x0v <<- c(x0v, x0v[i])
-###                        feat.v <- c(feat.v, edge.feat[br[1]])
-###                        ## shorten the line:
-###                        y0v[i] <<- yy[i + Ntip]
-###                    }
-###                }
-###            }
-###        }
-###        feat.v
-###    }
-###    color.v <- foo(edge.color, "black")
-###    width.v <- foo(edge.width, 1)
-###    lty.v <- foo(edge.lty, 1)
-
-###    ## we need to reorder:
-###    edge.width <- edge.width[pos]
-###    edge.color <- edge.color[pos]
-###    edge.lty <- edge.lty[pos]
-
     if (horizontal) {
         segments(x0h, y0h, x1h, y0h, col = edge.color, lwd = edge.width, lty = edge.lty) # draws horizontal lines
         segments(x0v, y0v, x0v, y1v, col = color.v, lwd = width.v, lty = lty.v) # draws vertical lines
@@ -595,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)
@@ -610,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)
@@ -618,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)
@@ -639,6 +595,57 @@ node.depth <- function(phy)
        as.integer(N), double(n + m), DUP = FALSE, PACKAGE = "ape")[[6]]
 }
 
+node.depth.edgelength <- function(phy)
+{
+    n <- length(phy$tip.label)
+    m <- phy$Nnode
+    N <- dim(phy$edge)[1]
+    phy <- reorder(phy, order = "pruningwise")
+    .C("node_depth_edgelength", as.integer(n), as.integer(n),
+       as.integer(phy$edge[, 1]), as.integer(phy$edge[, 2]),
+       as.integer(N), as.double(phy$edge.length), double(n + m),
+       DUP = FALSE, PACKAGE = "ape")[[7]]
+}
+
+node.height <- function(phy)
+{
+    n <- length(phy$tip.label)
+    m <- phy$Nnode
+    N <- dim(phy$edge)[1]
+    phy <- reorder(phy, order = "pruningwise")
+
+    e1 <- phy$edge[, 1]
+    e2 <- phy$edge[, 2]
+
+    yy <- numeric(n + m)
+    TIPS <- e2[e2 <= n]
+    yy[TIPS] <- 1:n
+
+    .C("node_height", as.integer(n), as.integer(m),
+       as.integer(e1), as.integer(e2), as.integer(N),
+       as.double(yy), DUP = FALSE, PACKAGE = "ape")[[6]]
+}
+
+node.height.clado <- function(phy)
+{
+    n <- length(phy$tip.label)
+    m <- phy$Nnode
+    N <- dim(phy$edge)[1]
+    phy <- reorder(phy, order = "pruningwise")
+
+    e1 <- phy$edge[, 1]
+    e2 <- phy$edge[, 2]
+
+    yy <- numeric(n + m)
+    TIPS <- e2[e2 <= n]
+    yy[TIPS] <- 1:n
+
+    .C("node_height_clado", as.integer(n), as.integer(m),
+       as.integer(e1), as.integer(e2), as.integer(N),
+       double(n + m), as.double(yy), DUP = FALSE,
+       PACKAGE = "ape")[[7]]
+}
+
 plot.multiPhylo <- function(x, layout = 1, ...)
 {
     if (layout > 1)
@@ -648,5 +655,80 @@ 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]], ...)
+}
+
+trex <- function(phy, title = TRUE, subbg = "lightyellow3",
+                 return.tree = FALSE, ...)
+{
+    lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
+    devmain <- dev.cur() # where the main tree is plotted
+
+    restore <- function() {
+        dev.set(devmain)
+        assign("last_plot.phylo", lastPP, envir = .PlotPhyloEnv)
+    }
+
+    on.exit(restore())
+    NEW <- TRUE
+    cat("Click close to a node. Right-click to exit.\n")
+    repeat {
+        x <- identify.phylo(phy, quiet = TRUE)
+        if (is.null(x)) return(invisible(NULL)) else {
+            x <- x$nodes
+            if (is.null(x)) cat("Try again!\n") else {
+                if (NEW) {
+                    dev.new()
+                    par(bg = subbg)
+                    devsub <- dev.cur()
+                    NEW <- FALSE
+                } else dev.set(devsub)
+
+                tr <- extract.clade(phy, x)
+                plot(tr, ...)
+                if (is.character(title)) title(title)
+                else if (title) {
+                     tl <-
+                         if (is.null(phy$node.label))
+                         paste("From node #", x, sep = "")
+                         else paste("From", phy$node.label[x - Ntip(phy)])
+                     title(tl)
+                }
+                if (return.tree) return(tr)
+                restore()
+            }
+        }
+    }
+}
+
+kronoviz <- function(x, layout = length(x), horiz = TRUE, ...)
+{
+    par(mar = rep(0.5, 4), oma = rep(2, 4))
+    rts <- sapply(x, function(x) branching.times(x)[1])
+    maxrts <- max(rts)
+    lim <- cbind(rts - maxrts, rts)
+    Ntree <- length(x)
+    Ntips <- sapply(x, Ntip)
+    if (horiz) {
+        nrow <- layout
+        w <- 1
+        h <- Ntips
+    } else {
+        nrow <- 1
+        w <- Ntips
+        h <- 1
+    }
+    layout(matrix(1:layout, nrow), widths = w, heights = h)
+    if (layout > Ntree && !par("ask")) {
+        par(ask = TRUE)
+        on.exit(par(ask = FALSE))
+    }
+    if (horiz) {
+        for (i in 1:Ntree)
+            plot(x[[i]], x.lim = lim[i, ], ...)
+    } else {
+        for (i in 1:Ntree)
+            plot(x[[i]], y.lim = lim[i, ], direction = "u", ...)
+    }
+    axisPhylo(if (horiz) 1 else 4) # better if the deepest tree is last ;)
 }