[Vegan-commits] r2191 - in pkg/vegan: R inst
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat May 26 11:09:33 CEST 2012
Author: gsimpson
Date: 2012-05-26 11:09:33 +0200 (Sat, 26 May 2012)
New Revision: 2191
Added:
pkg/vegan/R/checkSelect.R
Modified:
pkg/vegan/R/ordipointlabel.R
pkg/vegan/R/plot.prc.R
pkg/vegan/R/points.cca.R
pkg/vegan/R/points.decorana.R
pkg/vegan/R/points.metaMDS.R
pkg/vegan/R/points.ordiplot.R
pkg/vegan/R/text.cca.R
pkg/vegan/R/text.decorana.R
pkg/vegan/R/text.metaMDS.R
pkg/vegan/R/text.ordiplot.R
pkg/vegan/inst/ChangeLog
Log:
add .checkSelect() and use it for all plotting functions that have a select argument
Added: pkg/vegan/R/checkSelect.R
===================================================================
--- pkg/vegan/R/checkSelect.R (rev 0)
+++ pkg/vegan/R/checkSelect.R 2012-05-26 09:09:33 UTC (rev 2191)
@@ -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: pkg/vegan/R/ordipointlabel.R
===================================================================
--- pkg/vegan/R/ordipointlabel.R 2012-05-26 05:39:17 UTC (rev 2190)
+++ pkg/vegan/R/ordipointlabel.R 2012-05-26 09:09:33 UTC (rev 2191)
@@ -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: pkg/vegan/R/plot.prc.R
===================================================================
--- pkg/vegan/R/plot.prc.R 2012-05-26 05:39:17 UTC (rev 2190)
+++ pkg/vegan/R/plot.prc.R 2012-05-26 09:09:33 UTC (rev 2191)
@@ -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: pkg/vegan/R/points.cca.R
===================================================================
--- pkg/vegan/R/points.cca.R 2012-05-26 05:39:17 UTC (rev 2190)
+++ pkg/vegan/R/points.cca.R 2012-05-26 09:09:33 UTC (rev 2191)
@@ -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: pkg/vegan/R/points.decorana.R
===================================================================
--- pkg/vegan/R/points.decorana.R 2012-05-26 05:39:17 UTC (rev 2190)
+++ pkg/vegan/R/points.decorana.R 2012-05-26 09:09:33 UTC (rev 2191)
@@ -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: pkg/vegan/R/points.metaMDS.R
===================================================================
--- pkg/vegan/R/points.metaMDS.R 2012-05-26 05:39:17 UTC (rev 2190)
+++ pkg/vegan/R/points.metaMDS.R 2012-05-26 09:09:33 UTC (rev 2191)
@@ -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: pkg/vegan/R/points.ordiplot.R
===================================================================
--- pkg/vegan/R/points.ordiplot.R 2012-05-26 05:39:17 UTC (rev 2190)
+++ pkg/vegan/R/points.ordiplot.R 2012-05-26 09:09:33 UTC (rev 2191)
@@ -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: pkg/vegan/R/text.cca.R
===================================================================
--- pkg/vegan/R/text.cca.R 2012-05-26 05:39:17 UTC (rev 2190)
+++ pkg/vegan/R/text.cca.R 2012-05-26 09:09:33 UTC (rev 2191)
@@ -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: pkg/vegan/R/text.decorana.R
===================================================================
--- pkg/vegan/R/text.decorana.R 2012-05-26 05:39:17 UTC (rev 2190)
+++ pkg/vegan/R/text.decorana.R 2012-05-26 09:09:33 UTC (rev 2191)
@@ -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: pkg/vegan/R/text.metaMDS.R
===================================================================
--- pkg/vegan/R/text.metaMDS.R 2012-05-26 05:39:17 UTC (rev 2190)
+++ pkg/vegan/R/text.metaMDS.R 2012-05-26 09:09:33 UTC (rev 2191)
@@ -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: pkg/vegan/R/text.ordiplot.R
===================================================================
--- pkg/vegan/R/text.ordiplot.R 2012-05-26 05:39:17 UTC (rev 2190)
+++ pkg/vegan/R/text.ordiplot.R 2012-05-26 09:09:33 UTC (rev 2191)
@@ -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: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog 2012-05-26 05:39:17 UTC (rev 2190)
+++ pkg/vegan/inst/ChangeLog 2012-05-26 09:09:33 UTC (rev 2191)
@@ -4,6 +4,11 @@
Version 2.1-16 (opened May 11, 2012)
+ * .checkSelect: standardise those plotting functions that have a
+ 'select' argument that controls which rows of the scores are
+ plotted. All these functions now use .checkSelect() to check and
+ apply 'select' as appropriate.
+
* ordipointlabel: gains argument 'select' which allows some rows
of the plotted scores to be skipped in the same manner as for
text.cca(). This only applies when a single set of scores is
@@ -11,7 +16,7 @@
* ordihull, ordiellipse: defaults to use semitransparent fill
colour with 'draw = "polygon"', and gain argument 'alpha' to set
- the transparency.
+ the transparency.
* ordihull: gained explicit 'col' argument and adds labels after
drawing convex hulls so that filled hulls (with 'draw = "polygon")
More information about the Vegan-commits
mailing list