https://github.com/cran/ape
Tip revision: 99d71319a5c4561d32898283c275fb92ce405189 authored by Emmanuel Paradis on 31 May 2005, 00:00:00 UTC
version 1.6
version 1.6
Tip revision: 99d7131
nodelabels.R
### nodelabels.R (2004-11-10)
###
### Labelling the Nodes of a Tree
###
### Copyright 2004 Emmanuel Paradis <paradis@isem.univ-montp2.fr>
###
### This file is part of the `ape' library for R and related languages.
### It is made available under the terms of the GNU General Public
### License, version 2, or at your option, any later version,
### incorporated herein by reference.
###
### This program is distributed in the hope that it will be
### useful, but WITHOUT ANY WARRANTY; without even the implied
### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
### PURPOSE. See the GNU General Public License for more
### details.
###
### You should have received a copy of the GNU General Public
### License along with this program; if not, write to the Free
### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
### MA 02111-1307, USA
nodelabels <- function(text, node, adj = c(0.5, 0.5), frame = "rect",
pch = NULL, col = "black", bg = "lightblue", ...)
{
sel <- if (missing(node))
names(.last_plot.phylo$xx)[as.numeric(names(.last_plot.phylo$xx)) < 0]
else as.character(-abs(as.numeric(node)))
if (missing(text)) text <- NULL
if (length(adj) == 1) adj <- c(adj, 0.5)
if (is.null(text) & is.null(pch))
text <- names(.last_plot.phylo$xx)[as.numeric(names(.last_plot.phylo$xx)) < 0]
frame <- match.arg(frame, c("rect", "circle", "none"))
args <- list(...)
CEX <- if ("cex" %in% names(args)) args$cex else par("cex")
if (frame != "none" & !is.null(text)) {
if (frame == "rect") {
offs <- xinch(0.03)
xl <- .last_plot.phylo$xx[sel] - strwidth(text) * CEX * adj[1] - offs
xr <- xl + strwidth(text) * CEX + 2 * offs
yb <- .last_plot.phylo$yy[sel] - strheight(text) * CEX * adj[2] - offs
yt <- yb + strheight(text) * CEX + 2 * offs
rect(xl, yb, xr, yt, col = bg)
}
if (frame == "circle") {
radii <- apply(cbind(strheight(text), strwidth(text)), 1, max) * 0.6
symbols(.last_plot.phylo$xx[sel], .last_plot.phylo$yy[sel],
circles = radii, inches = FALSE, add = TRUE,
bg = bg)
}
}
if (!is.null(text)) text(.last_plot.phylo$xx[sel],
.last_plot.phylo$yy[sel],
text, adj = adj, ...)
if (!is.null(pch)) points(.last_plot.phylo$xx[sel],
.last_plot.phylo$yy[sel],
pch = pch, col = col, bg = bg, ...)
}