X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=R%2Fplot.phylo.R;h=eb3ad5c098d536da2ce0e174928b26aa7a9f7061;hb=b9f8872e29c6dbda44f60f67b9797dd90a119de6;hp=4ee98b654f3cf4fe19544439c2dba81c7ab0aa96;hpb=42bf3d36a0a2a5edd0071739ad346ae9009abffa;p=ape.git diff --git a/R/plot.phylo.R b/R/plot.phylo.R index 4ee98b6..eb3ad5c 100644 --- a/R/plot.phylo.R +++ b/R/plot.phylo.R @@ -1,4 +1,4 @@ -## plot.phylo.R (2009-09-23) +## plot.phylo.R (2009-09-30) ## Plot Phylogenies @@ -130,8 +130,7 @@ 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 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 @@ -149,9 +148,7 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE, } 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) @@ -160,8 +157,7 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE, ## 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: @@ -171,7 +167,7 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE, Y <- .nodeHeight(Ntip, Nnode, z$edge, Nedge, yy) xx <- X * cos(Y) yy <- X * sin(Y) - } + }) if (phyloORclado) { if (!horizontal) { tmp <- yy @@ -205,25 +201,22 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE, 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 @@ -254,25 +247,22 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE, 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 @@ -285,8 +275,7 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE, 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")) 1 else NA # fix by Klaus Schliep (2008-03-28) plot(0, type = "n", xlim = x.lim, ylim = y.lim, ann = FALSE, axes = FALSE, asp = asp, ...) if (is.null(adj)) adj <- if (phyloORclado && direction == "leftwards") 1 else 0 @@ -432,18 +421,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) @@ -496,44 +476,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