From e5e13543a283e5b45e4f03d095a177a17317cbf7 Mon Sep 17 00:00:00 2001 From: paradis Date: Fri, 27 Mar 2009 10:20:14 +0000 Subject: [PATCH] added edge.lty to plot.phylo git-svn-id: https://svn.mpl.ird.fr/ape/dev/ape@68 6e262413-ae40-0410-9e79-b911bd7a66b7 --- ChangeLog | 5 +++- DESCRIPTION | 2 +- R/plot.phylo.R | 72 +++++++++++++++++++++++------------------------ man/plot.phylo.Rd | 4 ++- man/rotate.Rd | 2 +- 5 files changed, 44 insertions(+), 41 deletions(-) diff --git a/ChangeLog b/ChangeLog index 34d2b12..a32f0f8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -14,7 +14,10 @@ NEW FEATURES labels in a flexible way. o read.tree() and write.tree() have been modified so that they can - handle individual tree names + handle individual tree names. + + o plot.phylo() has a new argument 'edge.lty' that specifies the + types of lines used for the edges (plain, dotted, dashed, ...) BUG FIXES diff --git a/DESCRIPTION b/DESCRIPTION index 94a1c6f..bcf5e68 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ape Version: 2.3 -Date: 2009-03-23 +Date: 2009-03-27 Title: Analyses of Phylogenetics and Evolution Author: Emmanuel Paradis, Ben Bolker, diff --git a/R/plot.phylo.R b/R/plot.phylo.R index ca3ff1c..fe45432 100644 --- a/R/plot.phylo.R +++ b/R/plot.phylo.R @@ -1,8 +1,8 @@ -## plot.phylo.R (2008-05-08) +## plot.phylo.R (2009-03-27) ## Plot Phylogenies -## Copyright 2002-2008 Emmanuel Paradis +## Copyright 2002-2009 Emmanuel Paradis ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. @@ -10,7 +10,7 @@ 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, font = 3, cex = par("cex"), + 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", @@ -44,6 +44,7 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE, } 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") @@ -277,13 +278,13 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE, } if (type == "phylogram") { phylogram.plot(x$edge, Ntip, Nnode, xx, yy, - horizontal, edge.color, edge.width) + horizontal, edge.color, edge.width, edge.lty) } else { if (type == "fan") circular.plot(x$edge, Ntip, Nnode, xx, yy, theta, - r, edge.color, edge.width) + r, edge.color, edge.width, edge.lty) else - cladogram.plot(x$edge, xx, yy, edge.color, edge.width) + cladogram.plot(x$edge, xx, yy, edge.color, edge.width, edge.lty) } if (root.edge) switch(direction, @@ -362,8 +363,8 @@ plot.phylo <- function(x, type = "phylogram", use.edge.length = TRUE, invisible(L) } -phylogram.plot <- function(edge, Ntip, Nnode, xx, yy, - horizontal, edge.color, edge.width) +phylogram.plot <- function(edge, Ntip, Nnode, xx, yy, horizontal, + edge.color, edge.width, edge.lty) { nodes <- (Ntip + 1):(Ntip + Nnode) if (!horizontal) { @@ -390,46 +391,42 @@ phylogram.plot <- function(edge, Ntip, Nnode, xx, yy, pos <- match(sq, edge[, 2]) x0h <- xx[edge[pos, 1]] - e.w <- unique(edge.width) - if (length(e.w) == 1) width.v <- rep(e.w, Nnode) - else { - width.v <- rep(1, Nnode) - for (i in 1:Nnode) { - br <- edge[which(edge[, 1] == i + Ntip), 2] - width <- unique(edge.width[br]) - if (length(width) == 1) width.v[i] <- width - } - } - e.c <- unique(edge.color) - if (length(e.c) == 1) color.v <- rep(e.c, Nnode) - else { - color.v <- rep("black", Nnode) - for (i in 1:Nnode) { - br <- which(edge[, 1] == i + Ntip) - #br <- edge[which(edge[, 1] == i + Ntip), 2] - color <- unique(edge.color[br]) - if (length(color) == 1) color.v[i] <- color + ## 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 <- which(edge[, 1] == i + Ntip) + x <- unique(edge.feat[br]) + if (length(x) == 1) feat.v[i] <- x + } } + 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.color' and `edge.width': + ## we need to reorder: edge.width <- edge.width[pos] edge.color <- edge.color[pos] + edge.lty <- edge.lty[pos] if (horizontal) { - segments(x0v, y0v, x0v, y1v, col = color.v, lwd = width.v) # draws vertical lines - segments(x0h, y0h, x1h, y0h, col = edge.color, lwd = edge.width) # draws horizontal lines + segments(x0v, y0v, x0v, y1v, col = color.v, lwd = width.v, lty = lty.v) # draws vertical lines + segments(x0h, y0h, x1h, y0h, col = edge.color, lwd = edge.width, lty = edge.lty) # draws horizontal lines } else { - segments(y0v, x0v, y1v, x0v, col = color.v, lwd = width.v) # draws horizontal lines - segments(y0h, x0h, y0h, x1h, col = edge.color, lwd = edge.width) # draws vertical lines + segments(y0v, x0v, y1v, x0v, col = color.v, lwd = width.v, lty = lty.v) # draws horizontal lines + segments(y0h, x0h, y0h, x1h, col = edge.color, lwd = edge.width, lty = edge.lty) # draws vertical lines } } -cladogram.plot <- function(edge, xx, yy, edge.color, edge.width) +cladogram.plot <- function(edge, xx, yy, edge.color, edge.width, edge.lty) segments(xx[edge[, 1]], yy[edge[, 1]], xx[edge[, 2]], yy[edge[, 2]], - col = edge.color, lwd = edge.width) + col = edge.color, lwd = edge.width, lty = edge.lty) circular.plot <- function(edge, Ntip, Nnode, xx, yy, theta, - r, edge.color, edge.width) + r, edge.color, edge.width, edge.lty) { r0 <- r[edge[, 1]] r1 <- r[edge[, 2]] @@ -440,7 +437,7 @@ circular.plot <- function(edge, Ntip, Nnode, xx, yy, theta, x1 <- r1*cos(theta0) y1 <- r1*sin(theta0) - segments(x0, y0, x1, y1, col = edge.color, lwd = edge.width) + segments(x0, y0, x1, y1, col = edge.color, lwd = edge.width, lty = edge.lty) tmp <- which(diff(edge[, 1]) != 0) start <- c(1, tmp + 1) @@ -453,7 +450,8 @@ circular.plot <- function(edge, Ntip, Nnode, xx, yy, theta, Y <- seq(theta[edge[i, 2]], theta[edge[j, 2]], length.out = 100) co <- if (edge.color[i] == edge.color[j]) edge.color[i] else "black" lw <- if (edge.width[i] == edge.width[j]) edge.width[i] else 1 - lines(X*cos(Y), X*sin(Y), col = co, lwd = lw) + ly <- if (edge.lty[i] == edge.lty[j]) edge.lty[i] else 1 + lines(X*cos(Y), X*sin(Y), col = co, lwd = lw, lty = ly) } } diff --git a/man/plot.phylo.Rd b/man/plot.phylo.Rd index dcabb28..ba98021 100644 --- a/man/plot.phylo.Rd +++ b/man/plot.phylo.Rd @@ -5,7 +5,7 @@ \usage{ \method{plot}{phylo}(x, type = "phylogram", use.edge.length = TRUE, node.pos = NULL, show.tip.label = TRUE, show.node.label = FALSE, - edge.color = "black", edge.width = 1, font = 3, + 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", @@ -42,6 +42,8 @@ the plotted phylogeny. These are taken to be in the same order than the component \code{edge} of \code{phy}. If fewer widths are given than the length of \code{edge}, then these are recycled.} + \item{edge.lty}{same than the previous argument but for line types; + 1: plain, 2: dashed, 3: dotted, 4: dotdash, 5: longdash, 6: twodash.} \item{font}{an integer specifying the type of font for the labels: 1 (plain text), 2 (bold), 3 (italic, the default), or 4 (bold italic).} diff --git a/man/rotate.Rd b/man/rotate.Rd index 13fed06..850247a 100644 --- a/man/rotate.Rd +++ b/man/rotate.Rd @@ -1,6 +1,6 @@ \name{rotate} \alias{rotate} -\title{Swopping sister clades} +\title{Swapping sister clades} \description{ For a given node, rotate exchanges the position of two clades descending from this node. It can handle dichotomies as well as polytomies. In the latter case, two clades from the polytomy are selected for swapping.} \usage{ -- 2.39.5