[Vegan-commits] r2194 - in branches/2.0: R inst
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat May 26 20:29:22 CEST 2012
Author: gsimpson
Date: 2012-05-26 20:29:22 +0200 (Sat, 26 May 2012)
New Revision: 2194
Added:
branches/2.0/R/checkSelect.R
Modified:
branches/2.0/R/ordilabel.R
branches/2.0/R/ordipointlabel.R
branches/2.0/R/plot.prc.R
branches/2.0/R/points.cca.R
branches/2.0/R/points.decorana.R
branches/2.0/R/points.metaMDS.R
branches/2.0/R/points.ordiplot.R
branches/2.0/R/text.cca.R
branches/2.0/R/text.decorana.R
branches/2.0/R/text.metaMDS.R
branches/2.0/R/text.ordiplot.R
branches/2.0/inst/ChangeLog
Log:
merge r2191-2193 to 2.0 branch and document ChangeLog
Copied: branches/2.0/R/checkSelect.R (from rev 2191, pkg/vegan/R/checkSelect.R)
===================================================================
--- branches/2.0/R/checkSelect.R (rev 0)
+++ branches/2.0/R/checkSelect.R 2012-05-26 18:29:22 UTC (rev 2194)
@@ -0,0 +1,16 @@
+## internal function for checking select arguments in ordination plotting
+## functions
+.checkSelect <- function(select, scores) {
+ ## check `select` and length of scores match
+ if(is.logical(select) &&
+ !isTRUE(all.equal(length(select), NROW(scores)))) {
+ warning("Length of logical vector 'select' does not match the number of scores.\nIgnoring 'select'.")
+ } else {
+ scores <- if(is.matrix(scores)) {
+ scores[select, , drop = FALSE]
+ } else {
+ scores[select]
+ }
+ }
+ scores
+}
Modified: branches/2.0/R/ordilabel.R
===================================================================
--- branches/2.0/R/ordilabel.R 2012-05-26 10:24:01 UTC (rev 2193)
+++ branches/2.0/R/ordilabel.R 2012-05-26 18:29:22 UTC (rev 2194)
@@ -9,8 +9,8 @@
if (missing(labels))
labels <- rownames(x)
if (!missing(select)) {
- x <- x[select, , drop = FALSE]
- labels <- labels[select]
+ x <- .checkSelect(select, x)
+ labels <- .checkSelect(select, labels)
}
if (!missing(priority)) {
if (!missing(select))
Modified: branches/2.0/R/ordipointlabel.R
===================================================================
--- branches/2.0/R/ordipointlabel.R 2012-05-26 10:24:01 UTC (rev 2193)
+++ branches/2.0/R/ordipointlabel.R 2012-05-26 18:29:22 UTC (rev 2194)
@@ -13,13 +13,7 @@
## only useful if we are displaying only one set of scores
if(!missing(select)) {
if(isTRUE(all.equal(length(display), 1L))) {
- ## check `select` and length of scores match
- if(is.logical(select) &&
- !isTRUE(all.equal(length(select), NROW(xy[[1]])))) {
- warning("Length of logical vector 'select' does not match the number of scores.\nIgnoring 'select'.")
- } else {
- xy[[1]] <- xy[[1]][select, , drop = FALSE]
- }
+ xy[[1]] <- .checkSelect(select, xy[[1]])
} else {
warning("'select' does not apply when plotting more than one set of scores.\n'select' was ignored.")
}
Modified: branches/2.0/R/plot.prc.R
===================================================================
--- branches/2.0/R/plot.prc.R 2012-05-26 10:24:01 UTC (rev 2193)
+++ branches/2.0/R/plot.prc.R 2012-05-26 18:29:22 UTC (rev 2194)
@@ -10,12 +10,12 @@
on.exit(par(oldpar))
b <- t(coef(x))
xax <- rownames(b)
- if (missing(xlab))
+ if (missing(xlab))
xlab <- x$names[1]
if (missing(ylab))
ylab <- "Effect"
if (!missing(select))
- x$sp <- x$sp[select]
+ x$sp <- .checkSelect(select, x$sp)
if (missing(ylim))
ylim <- if (species)
range(b, x$sp, na.rm = TRUE)
Modified: branches/2.0/R/points.cca.R
===================================================================
--- branches/2.0/R/points.cca.R 2012-05-26 10:24:01 UTC (rev 2193)
+++ branches/2.0/R/points.cca.R 2012-05-26 18:29:22 UTC (rev 2194)
@@ -1,14 +1,14 @@
`points.cca` <-
- function (x, display = "sites", choices = c(1, 2), scaling = 2,
- arrow.mul, head.arrow = 0.05, select, const, ...)
+ function (x, display = "sites", choices = c(1, 2), scaling = 2,
+ arrow.mul, head.arrow = 0.05, select, const, ...)
{
formals(arrows) <- c(formals(arrows), alist(... = ))
- if (length(display) > 1)
+ if (length(display) > 1)
stop("Only one 'display' item can be added in one command.")
pts <- scores(x, choices = choices, display = display, scaling = scaling,
const)
- if (!missing(select))
- pts <- pts[select, , drop = FALSE]
+ if (!missing(select))
+ pts <- .checkSelect(select, pts)
if (display == "cn") {
cnam <- rownames(pts)
points(pts, ...)
@@ -16,7 +16,7 @@
const)
bnam <- rownames(pts)
pts <- pts[!(bnam %in% cnam), , drop = FALSE]
- if (nrow(pts) == 0)
+ if (nrow(pts) == 0)
return(invisible())
else display <- "bp"
}
@@ -25,12 +25,12 @@
arrow.mul <- ordiArrowMul(pts)
}
pts <- pts * arrow.mul
- arrows(0, 0, pts[, 1], pts[, 2], length = head.arrow,
+ arrows(0, 0, pts[, 1], pts[, 2], length = head.arrow,
...)
pts <- pts * 1.1
- axis(3, at = c(-arrow.mul, 0, arrow.mul), labels = rep("",
+ axis(3, at = c(-arrow.mul, 0, arrow.mul), labels = rep("",
3))
- axis(4, at = c(-arrow.mul, 0, arrow.mul), labels = c(-1,
+ axis(4, at = c(-arrow.mul, 0, arrow.mul), labels = c(-1,
0, 1))
return(invisible())
}
Modified: branches/2.0/R/points.decorana.R
===================================================================
--- branches/2.0/R/points.decorana.R 2012-05-26 10:24:01 UTC (rev 2193)
+++ branches/2.0/R/points.decorana.R 2012-05-26 18:29:22 UTC (rev 2194)
@@ -5,7 +5,7 @@
display <- match.arg(display)
x <- scores(x, display = display, choices = choices, origin = origin, ...)
if (!missing(select))
- x <- x[select,,drop=FALSE]
+ x <- .checkSelect(select, x)
ordiArgAbsorber(x, FUN = points, ...)
invisible()
}
Modified: branches/2.0/R/points.metaMDS.R
===================================================================
--- branches/2.0/R/points.metaMDS.R 2012-05-26 10:24:01 UTC (rev 2193)
+++ branches/2.0/R/points.metaMDS.R 2012-05-26 18:29:22 UTC (rev 2194)
@@ -1,11 +1,11 @@
"points.metaMDS" <-
function (x, display = c("sites", "species"),
- choices = c(1, 2), shrink = FALSE, select, ...)
+ choices = c(1, 2), shrink = FALSE, select, ...)
{
display <- match.arg(display)
x <- scores(x, display = display, choices = choices, shrink = shrink)
if (!missing(select))
- x <- x[select,,drop=FALSE]
+ x <- .checkSelect(select, x)
points(x, ...)
invisible()
}
Modified: branches/2.0/R/points.ordiplot.R
===================================================================
--- branches/2.0/R/points.ordiplot.R 2012-05-26 10:24:01 UTC (rev 2193)
+++ branches/2.0/R/points.ordiplot.R 2012-05-26 18:29:22 UTC (rev 2194)
@@ -1,9 +1,9 @@
"points.ordiplot" <-
- function (x, what, select, ...)
+ function (x, what, select, ...)
{
x <- scores(x, what)
if (!missing(select))
- x <- x[select,,drop=FALSE]
+ x <- .checkSelect(select, x)
points(x, ...)
invisible()
}
Modified: branches/2.0/R/text.cca.R
===================================================================
--- branches/2.0/R/text.cca.R 2012-05-26 10:24:01 UTC (rev 2193)
+++ branches/2.0/R/text.cca.R 2012-05-26 18:29:22 UTC (rev 2194)
@@ -1,16 +1,16 @@
`text.cca` <-
- function (x, display = "sites", labels, choices = c(1, 2), scaling = 2,
- arrow.mul, head.arrow = 0.05, select, const, ...)
+ function (x, display = "sites", labels, choices = c(1, 2), scaling = 2,
+ arrow.mul, head.arrow = 0.05, select, const, ...)
{
formals(arrows) <- c(formals(arrows), alist(... = ))
- if (length(display) > 1)
+ if (length(display) > 1)
stop("Only one 'display' item can be added in one command.")
pts <- scores(x, choices = choices, display = display, scaling = scaling,
const)
if (!missing(labels))
rownames(pts) <- labels
- if (!missing(select))
- pts <- pts[select, , drop = FALSE]
+ if (!missing(select))
+ pts <- .checkSelect(select, pts)
if (display == "cn") {
cnam <- rownames(pts)
text(pts, labels = cnam, ...)
@@ -18,7 +18,7 @@
const)
bnam <- rownames(pts)
pts <- pts[!(bnam %in% cnam), , drop = FALSE]
- if (nrow(pts) == 0)
+ if (nrow(pts) == 0)
return(invisible())
else display <- "bp"
}
@@ -27,12 +27,12 @@
arrow.mul <- ordiArrowMul(pts)
}
pts <- pts * arrow.mul
- arrows(0, 0, pts[, 1], pts[, 2], length = head.arrow,
+ arrows(0, 0, pts[, 1], pts[, 2], length = head.arrow,
...)
pts <- pts * 1.1
- axis(3, at = c(-arrow.mul, 0, arrow.mul), labels = rep("",
+ axis(3, at = c(-arrow.mul, 0, arrow.mul), labels = rep("",
3))
- axis(4, at = c(-arrow.mul, 0, arrow.mul), labels = c(-1,
+ axis(4, at = c(-arrow.mul, 0, arrow.mul), labels = c(-1,
0, 1))
}
text(pts, labels = rownames(pts), ...)
Modified: branches/2.0/R/text.decorana.R
===================================================================
--- branches/2.0/R/text.decorana.R 2012-05-26 10:24:01 UTC (rev 2193)
+++ branches/2.0/R/text.decorana.R 2012-05-26 18:29:22 UTC (rev 2194)
@@ -10,7 +10,7 @@
if (!missing(labels))
rownames(x) <- labels
if (!missing(select))
- x <- x[select, , drop = FALSE]
+ x <- .checkSelect(select, x)
localText(x, rownames(x), ...)
invisible()
}
Modified: branches/2.0/R/text.metaMDS.R
===================================================================
--- branches/2.0/R/text.metaMDS.R 2012-05-26 10:24:01 UTC (rev 2193)
+++ branches/2.0/R/text.metaMDS.R 2012-05-26 18:29:22 UTC (rev 2194)
@@ -1,13 +1,13 @@
"text.metaMDS" <-
- function (x, display = c("sites", "species"), labels,
- choices = c(1, 2), shrink = FALSE, select, ...)
+ function (x, display = c("sites", "species"), labels,
+ choices = c(1, 2), shrink = FALSE, select, ...)
{
display <- match.arg(display)
x <- scores(x, display = display, choices = choices, shrink = shrink)
if (!missing(labels))
rownames(x) <- labels
- if (!missing(select))
- x <- x[select, , drop = FALSE]
+ if (!missing(select))
+ x <- .checkSelect(select, x)
text(x, labels = rownames(x), ...)
invisible()
}
Modified: branches/2.0/R/text.ordiplot.R
===================================================================
--- branches/2.0/R/text.ordiplot.R 2012-05-26 10:24:01 UTC (rev 2193)
+++ branches/2.0/R/text.ordiplot.R 2012-05-26 18:29:22 UTC (rev 2194)
@@ -1,11 +1,11 @@
"text.ordiplot" <-
- function (x, what, labels, select, ...)
+ function (x, what, labels, select, ...)
{
x <- scores(x, what)
if (!missing(labels))
rownames(x) <- labels
- if (!missing(select))
- x <- x[select, , drop = FALSE]
+ if (!missing(select))
+ x <- .checkSelect(select, x)
text(x, labels = rownames(x), ...)
invisible()
}
Modified: branches/2.0/inst/ChangeLog
===================================================================
--- branches/2.0/inst/ChangeLog 2012-05-26 10:24:01 UTC (rev 2193)
+++ branches/2.0/inst/ChangeLog 2012-05-26 18:29:22 UTC (rev 2194)
@@ -3,7 +3,10 @@
VEGAN RELEASE VERSIONS at http://cran.r-project.org/
Version 2.0-4 (opened March 9, 2012)
-
+
+ * merge r2191-2193: standardise handling of 'select' arg in
+ those plotting functions that support it. Adds non-exported
+ function .checkSelect().
* merge r2178, 2180: ordipointlabel gains 'select' argument.
* merge r2173-2176, 2185: ordihull labels, semintransparent
colours in ordihull & ordiellipse.
@@ -11,12 +14,12 @@
* merge r2167: warn about unequal aspect ratio in ordiplot3d.
* merge r2162: set equal axis scales for ordiplot3d.
* merge r2156: betadisper example adapted for default spatial
- median.
+ median.
* merge r2150: monoMDS checks that the number of dissimilarities
is sufficient for the requested analysis. The decostand.Rd fix of
r2150 was not yet merged.
* merge r2149: drarefy & rrarefy check that input data are
- integers.
+ integers.
* merge r2148 (partial): format references. However, scoverage()
was not merged yet, and its changes have not been merged.
* merge r2144: hiersimu and multipart do not assume constant
@@ -27,15 +30,15 @@
* merge r2137: explain data transformation in pyrifos.Rd.
* merge r2135: print.adipart displays null model method.
* merge r2132: adipart bug fix: assumed constant gamma in
- permutations.
+ permutations.
* merge r2129: envfit failed with empty factor levels.
* merge r2128: anova(<prc-object>, by = ...) failed.
* merge r2127: more configurable msoplot.
* merge r2125: typo in anova.cca.Rd.
* merge r2123: r2121 for adonis.
* merge r2121: doc location/dispersion mix-up in simper, mrpp &
- anosim.
-
+ anosim.
+
Version 2.0-3 (released March 3, 2012)
* merge r2115: simper fixes from github EDiLD/vegan pull request
More information about the Vegan-commits
mailing list