X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=R%2Fplot.phylo.R;h=3fd0637295d84063afd81cbe2bea7d5509bbe7d4;hb=bfd7604547c1dd38cd97707c184bebf3525cf426;hp=18bba88509dd0bab1e37b91d3b274c26a6aee316;hpb=3f91879755fdbbe39cfd936495b2985fa4621615;p=ape.git diff --git a/R/plot.phylo.R b/R/plot.phylo.R index 18bba88..3fd0637 100644 --- a/R/plot.phylo.R +++ b/R/plot.phylo.R @@ -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)