[Vegan-commits] r1706 - in branches/1.17: R inst
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Aug 10 01:19:21 CEST 2011
Author: gsimpson
Date: 2011-08-10 01:19:20 +0200 (Wed, 10 Aug 2011)
New Revision: 1706
Modified:
branches/1.17/R/plot.envfit.R
branches/1.17/inst/ChangeLog
Log:
merge r1704 from trunk to 1.17 branch
Modified: branches/1.17/R/plot.envfit.R
===================================================================
--- branches/1.17/R/plot.envfit.R 2011-08-09 23:14:40 UTC (rev 1705)
+++ branches/1.17/R/plot.envfit.R 2011-08-09 23:19:20 UTC (rev 1706)
@@ -1,6 +1,6 @@
`plot.envfit` <-
- function (x, choices = c(1, 2), arrow.mul, at = c(0, 0),
- axis = FALSE, p.max = NULL, col = "blue", add = TRUE, ...)
+ function (x, choices = c(1, 2), arrow.mul, at = c(0, 0),
+ axis = FALSE, p.max = NULL, col = "blue", add = TRUE, ...)
{
formals(arrows) <- c(formals(arrows), alist(... = ))
vect <- NULL
@@ -9,16 +9,16 @@
take <- x$vectors$pvals <= p.max
x$vectors$arrows <- x$vectors$arrows[take, , drop = FALSE]
x$vectors$r <- x$vectors$r[take]
- if (nrow(x$vectors$arrows) == 0)
+ if (nrow(x$vectors$arrows) == 0)
x$vectors <- vect <- NULL
}
if (!is.null(x$factors)) {
tmp <- x$factors$pvals <= p.max
nam <- names(tmp)[tmp]
take <- x$factors$var.id %in% nam
- x$factors$centroids <- x$factors$centroids[take,
+ x$factors$centroids <- x$factors$centroids[take,
, drop = FALSE]
- if (nrow(x$factors$centroids) == 0)
+ if (nrow(x$factors$centroids) == 0)
x$factors <- NULL
}
}
@@ -27,7 +27,7 @@
if (missing(arrow.mul)) {
if(!add)
arrow.mul <- 1
- else
+ else
arrow.mul <- ordiArrowMul(vect, at = at)
}
if (axis) {
@@ -39,30 +39,63 @@
vect <- sweep(vect, 2, at, "+")
}
if (!add) {
- xlim <- range(at[1], vect[,1], x$factors$centroids[,1])
- ylim <- range(at[2], vect[,2], x$factors$centroids[,2])
- if (!is.null(vect))
- plot(vect, xlim = xlim, ylim = ylim, asp = 1, type = "n",
- ...)
- else if (!is.null(x$factors))
- plot(x$factors$centroids[, choices, drop = FALSE],
- asp = 1, xlim = xlim, ylim = ylim, type = "n",
- ...)
- else stop("Nothing to plot")
+ plot.new() ## needed for string widths and heights
+ if(!is.null(vect)) {
+ ## compute axis limits allowing space for labels
+ labs <- rownames(x$vectors$arrows)
+ sw <- strwidth(labs)
+ sh <- strheight(labs)
+ xlim <- range(at[1], vtext[,1] + sw, vtext[,1] - sw)
+ ylim <- range(at[2], vtext[,2] + sh, vtext[,2] - sh)
+ if(!is.null(x$factors)) {
+ ## if factors, also need to consider them
+ labs <- rownames(x$factors$centroids)
+ sw <- strwidth(labs)
+ sh <- strheight(labs)
+ xlim <- range(xlim, x$factors$centroids[, choices[1]] + sw,
+ x$factors$centroids[, choices[1]] - sw)
+ ylim <- range(ylim, x$factors$centroids[, choices[2]] + sh,
+ x$factors$centroids[, choices[2]] - sh)
+ }
+ ## these plotting calls will prob. generate warnings
+ ## because of passing ... everywhere. localFoo needed?
+ plot.window(xlim = xlim, ylim = ylim, asp = 1, ...)
+ axis(side = 1, ...)
+ axis(side = 2, ...)
+ box(...)
+ alabs <- colnames(vect)
+ title(..., ylab = alabs[2], xlab = alabs[1])
+ } else if (!is.null(x$factors)) {
+ labs <- rownames(x$factors$centroids)
+ sw <- strwidth(labs)
+ sh <- strheight(labs)
+ xlim <- range(at[1], x$factors$centroids[, choices[1]] + sw,
+ x$factors$centroids[, choices[1]] - sw)
+ ylim <- range(at[2], x$factors$centroids[, choices[2]] + sh,
+ x$factors$centroids[, choices[2]] - sh)
+ ## these plotting calls will prob. generate warnings
+ ## because of passing ... everywhere. localFoo needed?
+ plot.window(xlim = xlim, ylim = ylim, asp = 1, ...)
+ axis(side = 1, ...)
+ axis(side = 2, ...)
+ box(...)
+ alabs <- colnames(x$factors$centroids[, choices, drop = FALSE])
+ title(..., ylab = alabs[2], xlab = alabs[1])
+ } else stop("Nothing to plot")
}
if (!is.null(vect)) {
- arrows(at[1], at[2], vect[, 1], vect[, 2], len = 0.05,
+ arrows(at[1], at[2], vect[, 1], vect[, 2], len = 0.05,
col = col)
text(vtext, rownames(x$vectors$arrows), col = col, ...)
}
if (!is.null(x$factors)) {
- text(x$factors$centroids[, choices, drop = FALSE], rownames(x$factors$centroids),
+ text(x$factors$centroids[, choices, drop = FALSE], rownames(x$factors$centroids),
col = col, ...)
}
if (axis && !is.null(vect)) {
- axis(3, at = ax + at[1], labels = c(maxarr, 0, maxarr),
+ axis(3, at = ax + at[1], labels = c(maxarr, 0, maxarr),
col = col)
- axis(4, at = ax + at[2], labels = c(maxarr, 0, maxarr),
+ axis(4, at = ax + at[2], labels = c(maxarr, 0, maxarr),
col = col)
}
invisible()
Modified: branches/1.17/inst/ChangeLog
===================================================================
--- branches/1.17/inst/ChangeLog 2011-08-09 23:14:40 UTC (rev 1705)
+++ branches/1.17/inst/ChangeLog 2011-08-09 23:19:20 UTC (rev 1706)
@@ -8,6 +8,8 @@
1634). Basically everything except 'permute' dependence and
monoMDS. Also adds the minimal NAMESPACE file of 1695 (without S3
method registration and later revs).
+ * merged 1704: better axis limits in plot.envfit to allow space
+ for vector and centroid labels.
* partially merged 1700: model.{frame,matrix}.cca scoping.
* merged 1699: ade2vegancca typo.
* partially merged r1696: superfluous aliases in deviance.cca.Rd
More information about the Vegan-commits
mailing list