X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=R%2Fplot.phylo.R;h=b9309a004882249ce7444517e1eb1bdb1157e63f;hb=f5c4abe6ac31486e821d82788bf66b5db2be51d1;hp=3fd0637295d84063afd81cbe2bea7d5509bbe7d4;hpb=bfd7604547c1dd38cd97707c184bebf3525cf426;p=ape.git

diff --git a/R/plot.phylo.R b/R/plot.phylo.R
index 3fd0637..b9309a0 100644
--- a/R/plot.phylo.R
+++ b/R/plot.phylo.R
@@ -1,8 +1,8 @@
-## plot.phylo.R (2012-03-22)
+## plot.phylo.R (2013-01-11)
 
 ##   Plot Phylogenies
 
-## Copyright 2002-2012 Emmanuel Paradis
+## Copyright 2002-2013 Emmanuel Paradis
 
 ## This file is part of the R-package `ape'.
 ## See the file ../COPYING for licensing issues.
@@ -15,11 +15,12 @@ plot.phylo <-
              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, ...)
+             tip.color = "black", plot = TRUE, rotate.tree = 0,
+             open.angle = 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))
@@ -122,13 +123,15 @@ plot.phylo <-
             xx <- .nodeDepthEdgelength(Ntip, Nnode, z$edge, Nedge, z$edge.length)
         }
     } else {
-    rotate.tree <- 2 * pi * rotate.tree/360
+    twopi <- 2 * pi
+    rotate.tree <- twopi * 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
         TIPS <- x$edge[which(x$edge[, 2] <= Ntip), 2]
-        xx <- seq(0, 2*pi*(1 - 1/Ntip), 2*pi/Ntip)
+        xx <- seq(0, twopi * (1 - 1/Ntip) - twopi * open.angle/360,
+                  length.out = Ntip)
         theta <- double(Ntip)
         theta[TIPS] <- xx
         theta <- c(theta, numeric(Nnode))
@@ -140,8 +143,8 @@ plot.phylo <-
             r <- 1/r
         }
         theta <- theta + rotate.tree
-        xx <- r*cos(theta)
-        yy <- r*sin(theta)
+        xx <- r * cos(theta)
+        yy <- r * sin(theta)
     }, "unrooted" = {
         nb.sp <- .nodeDepth(Ntip, Nnode, z$edge, Nedge)
         XY <- if (use.edge.length)
@@ -157,7 +160,7 @@ plot.phylo <-
         ## radius:
         X <- 1 - X/Ntip
         ## angle (1st compute the angles for the tips):
-        yy <- c((1:Ntip)*2*pi/Ntip, rep(0, Nnode))
+        yy <- c((1:Ntip)*twopi/Ntip, rep(0, Nnode))
         Y <- .nodeHeight(Ntip, Nnode, z$edge, Nedge, yy)
         xx <- X * cos(Y + rotate.tree)
         yy <- X * sin(Y + rotate.tree)
@@ -375,7 +378,6 @@ if (plot) {
         if (type %in% c("fan", "radial")) {
             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)
@@ -421,7 +423,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:
@@ -595,14 +597,63 @@ 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)
-      layout(matrix(1:layout, ceiling(sqrt(layout)), byrow = TRUE))
-    else layout(matrix(1))
-    if (!par("ask")) {
-        par(ask = TRUE)
-        on.exit(par(ask = FALSE))
+    layout(matrix(1:layout, ceiling(sqrt(layout)), byrow = TRUE))
+    if (!devAskNewPage() && interactive()) {
+        devAskNewPage(TRUE)
+        on.exit(devAskNewPage(FALSE))
     }
     for (i in 1:length(x)) plot(x[[i]], ...)
 }
@@ -668,9 +719,9 @@ kronoviz <- function(x, layout = length(x), horiz = TRUE, ...)
         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 (layout < Ntree && !devAskNewPage() && interactive()) {
+        devAskNewPage(TRUE)
+        on.exit(devAskNewPage(FALSE))
     }
     if (horiz) {
         for (i in 1:Ntree)