[Vegan-commits] r2960 - in pkg/vegan: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Sep 15 09:23:31 CEST 2015
Author: jarioksa
Date: 2015-09-15 09:23:30 +0200 (Tue, 15 Sep 2015)
New Revision: 2960
Added:
pkg/vegan/R/scalingUtils.R
Modified:
pkg/vegan/R/biplot.rda.R
pkg/vegan/R/plot.cca.R
pkg/vegan/R/plot.prc.R
pkg/vegan/R/points.cca.R
pkg/vegan/R/predict.cca.R
pkg/vegan/R/predict.rda.R
pkg/vegan/R/scores.cca.R
pkg/vegan/R/scores.rda.R
pkg/vegan/R/summary.cca.R
pkg/vegan/R/summary.prc.R
pkg/vegan/R/text.cca.R
pkg/vegan/R/tolerance.cca.R
pkg/vegan/man/biplot.rda.Rd
pkg/vegan/man/plot.cca.Rd
pkg/vegan/man/prc.Rd
pkg/vegan/man/predict.cca.Rd
pkg/vegan/man/tolerance.Rd
Log:
Merge branch 'cran-2.3' into r-forge-svn-local
Modified: pkg/vegan/R/biplot.rda.R
===================================================================
--- pkg/vegan/R/biplot.rda.R 2015-09-09 08:19:06 UTC (rev 2959)
+++ pkg/vegan/R/biplot.rda.R 2015-09-15 07:23:30 UTC (rev 2960)
@@ -12,9 +12,10 @@
NextMethod("biplot", x, ...)
}
-`biplot.rda` <- function(x, choices = c(1, 2), scaling = 2,
- display = c("sites", "species"),
- type, xlim, ylim, col = c(1,2), const, ...) {
+`biplot.rda` <- function(x, choices = c(1, 2), scaling = "species",
+ display = c("sites", "species"),
+ type, xlim, ylim, col = c(1,2), const,
+ correlation = FALSE, ...) {
if(!inherits(x, "rda"))
stop("'biplot.rda' is only for objects of class 'rda'")
if(!is.null(x$CCA))
Modified: pkg/vegan/R/plot.cca.R
===================================================================
--- pkg/vegan/R/plot.cca.R 2015-09-09 08:19:06 UTC (rev 2959)
+++ pkg/vegan/R/plot.cca.R 2015-09-15 07:23:30 UTC (rev 2960)
@@ -1,9 +1,9 @@
-`plot.cca` <-
- function (x, choices = c(1, 2), display = c("sp", "wa", "cn"),
- scaling = 2, type, xlim, ylim, const, ...)
-{
+`plot.cca` <- function (x, choices = c(1, 2), display = c("sp", "wa", "cn"),
+ scaling = "species", type, xlim, ylim, const,
+ correlation = FALSE, hill = FALSE, ...) {
TYPES <- c("text", "points", "none")
- g <- scores(x, choices, display, scaling, const)
+ g <- scores(x, choices, display, scaling, const, correlation = correlation,
+ hill = hill)
if (length(g) == 0 || all(is.na(g)))
stop("nothing to plot: requested scores do not exist")
if (!is.list(g))
Modified: pkg/vegan/R/plot.prc.R
===================================================================
--- pkg/vegan/R/plot.prc.R 2015-09-09 08:19:06 UTC (rev 2959)
+++ pkg/vegan/R/plot.prc.R 2015-09-15 07:23:30 UTC (rev 2960)
@@ -1,11 +1,12 @@
`plot.prc` <-
- function (x, species = TRUE, select, scaling = 3, axis = 1, type = "l",
- xlab, ylab, ylim, lty = 1:5, col = 1:6, pch, legpos, cex = 0.8,
- ...)
+ function (x, species = TRUE, select, scaling = "symmetric", axis = 1,
+ correlation = FALSE, type = "l", xlab, ylab, ylim, lty = 1:5,
+ col = 1:6, pch, legpos, cex = 0.8, ...)
{
## save level names before getting the summary
levs <- x$terminfo$xlev[[2]]
- x <- summary(x, scaling = scaling, axis = axis)
+ x <- summary(x, scaling = scaling, axis = axis,
+ correlation = correlation)
oldpar <- par(no.readonly = TRUE)
on.exit(par(oldpar))
b <- t(coef(x))
Modified: pkg/vegan/R/points.cca.R
===================================================================
--- pkg/vegan/R/points.cca.R 2015-09-09 08:19:06 UTC (rev 2959)
+++ pkg/vegan/R/points.cca.R 2015-09-15 07:23:30 UTC (rev 2960)
@@ -1,19 +1,20 @@
`points.cca` <-
- function (x, display = "sites", choices = c(1, 2), scaling = 2,
- arrow.mul, head.arrow = 0.05, select, const, axis.bp = TRUE, ...)
+ function (x, display = "sites", choices = c(1, 2), scaling = "species",
+ arrow.mul, head.arrow = 0.05, select, const, axis.bp = TRUE,
+ correlation = FALSE, hill = FALSE, ...)
{
formals(arrows) <- c(formals(arrows), alist(... = ))
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)
+ const, correlation = correlation, hill = hill)
if (!missing(select))
pts <- .checkSelect(select, pts)
if (display == "cn") {
cnam <- rownames(pts)
points(pts, ...)
pts <- scores(x, choices = choices, display = "bp", scaling = scaling,
- const)
+ const, correlation = correlation, hill = hill)
bnam <- rownames(pts)
pts <- pts[!(bnam %in% cnam), , drop = FALSE]
if (nrow(pts) == 0)
Modified: pkg/vegan/R/predict.cca.R
===================================================================
--- pkg/vegan/R/predict.cca.R 2015-09-09 08:19:06 UTC (rev 2959)
+++ pkg/vegan/R/predict.cca.R 2015-09-15 07:23:30 UTC (rev 2960)
@@ -1,6 +1,7 @@
`predict.cca` <-
function (object, newdata, type = c("response", "wa", "sp", "lc", "working"),
- rank = "full", model = c("CCA", "CA"), scaling = FALSE, ...)
+ rank = "full", model = c("CCA", "CA"), scaling = FALSE,
+ hill = FALSE, ...)
{
type <- match.arg(type)
model <- match.arg(model)
@@ -20,6 +21,12 @@
if (is.null(w))
w <- u
slam <- diag(sqrt(object[[model]]$eig[1:take]), nrow = take)
+ ## process sclaing arg, this will ignore hill if scaling = FALSE or a numeric.
+ ## scaling also used later so needs to be a numeric (or something
+ ## coercible to one (FALSE)
+ if (is.character(scaling)) {
+ scaling <- scalingType(scaling = scaling, hill = hill)
+ }
if (type %in% c("response", "working")) {
Xbar <- 0
if (!missing(newdata)) {
Modified: pkg/vegan/R/predict.rda.R
===================================================================
--- pkg/vegan/R/predict.rda.R 2015-09-09 08:19:06 UTC (rev 2959)
+++ pkg/vegan/R/predict.rda.R 2015-09-15 07:23:30 UTC (rev 2960)
@@ -1,6 +1,7 @@
`predict.rda` <-
function (object, newdata, type = c("response", "wa", "sp", "lc", "working"),
- rank = "full", model = c("CCA", "CA"), scaling = FALSE, ...)
+ rank = "full", model = c("CCA", "CA"), scaling = FALSE,
+ correlation = FALSE, ...)
{
type <- match.arg(type)
model <- match.arg(model)
@@ -24,6 +25,12 @@
if (is.null(w))
w <- u
slam <- diag(sqrt(object[[model]]$eig[1:take] * nr), nrow = take)
+ ## process sclaing arg, this will ignore hill if scaling = FALSE or a numeric.
+ ## scaling also used later so needs to be a numeric (or something
+ ## coercible to one (FALSE)
+ if (is.character(scaling)) {
+ scaling <- scalingType(scaling = scaling, correlation = correlation)
+ }
if (type %in% c("response", "working")) {
if (!missing(newdata)) {
u <- predict(object, type = if(model == "CCA") "lc" else "wa",
Added: pkg/vegan/R/scalingUtils.R
===================================================================
--- pkg/vegan/R/scalingUtils.R (rev 0)
+++ pkg/vegan/R/scalingUtils.R 2015-09-15 07:23:30 UTC (rev 2960)
@@ -0,0 +1,17 @@
+##' @title Utility for handling user friendly scaling --- None exported
+##'
+##' @description Convert user-friendly descriptions of scalings to numeric codes used by \code{scores} to date.
+##'
+##' @param scaling character; which type of scaling is required?
+##' @param correlation logical; should correlation-like scores be returned?
+##' @param hill logical; should Hill's scaling scores be returned?
+`scalingType` <- function(scaling = c("none", "sites", "species", "symmetric"),
+ correlation = FALSE, hill = FALSE) {
+ tab <- c("none", "sites", "species", "symmetric")
+ scaling <- match.arg(scaling)
+ scl <- match(scaling, tab) - 1 # -1 as none == scaling 0
+ if (scl > 0 && (correlation || hill)) {
+ scl <- -scl
+ }
+ scl # return
+}
Modified: pkg/vegan/R/scores.cca.R
===================================================================
--- pkg/vegan/R/scores.cca.R 2015-09-09 08:19:06 UTC (rev 2959)
+++ pkg/vegan/R/scores.cca.R 2015-09-15 07:23:30 UTC (rev 2960)
@@ -1,6 +1,6 @@
`scores.cca` <-
- function (x, choices = c(1, 2), display = c("sp", "wa", "cn"),
- scaling = 2, ...)
+ function (x, choices = c(1, 2), display = c("sp", "wa", "cn"),
+ scaling = "species", hill = FALSE, ...)
{
if(inherits(x, "pcaiv")) {
warning("looks like ade4::cca object: you better use ade4 functions")
@@ -10,10 +10,10 @@
## "exclude"
if (!is.null(x$na.action) && inherits(x$na.action, "exclude"))
x <- ordiNApredict(x$na.action, x)
- tabula <- c("species", "sites", "constraints", "biplot",
+ tabula <- c("species", "sites", "constraints", "biplot",
"centroids")
names(tabula) <- c("sp", "wa", "lc", "bp", "cn")
- if (is.null(x$CCA))
+ if (is.null(x$CCA))
tabula <- tabula[1:2]
display <- match.arg(display, c("sites", "species", "wa",
"lc", "bp", "cn"),
@@ -26,6 +26,10 @@
slam <- sqrt(c(x$CCA$eig, x$CA$eig)[choices])
rnk <- x$CCA$rank
sol <- list()
+ ## check scaling for character & process it if so
+ if (is.character(scaling)) {
+ scaling <- scalingType(scaling = scaling, hill = hill)
+ }
if ("species" %in% take) {
v <- cbind(x$CCA$v, x$CA$v)[, choices, drop = FALSE]
if (scaling) {
@@ -64,18 +68,18 @@
}
if ("biplot" %in% take && !is.null(x$CCA$biplot)) {
b <- matrix(0, nrow(x$CCA$biplot), length(choices))
- b[, choices <= rnk] <- x$CCA$biplot[, choices[choices <=
+ b[, choices <= rnk] <- x$CCA$biplot[, choices[choices <=
rnk]]
colnames(b) <- c(colnames(x$CCA$u), colnames(x$CA$u))[choices]
rownames(b) <- rownames(x$CCA$biplot)
sol$biplot <- b
}
if ("centroids" %in% take) {
- if (is.null(x$CCA$centroids))
+ if (is.null(x$CCA$centroids))
sol$centroids <- NA
else {
cn <- matrix(0, nrow(x$CCA$centroids), length(choices))
- cn[, choices <= rnk] <- x$CCA$centroids[, choices[choices <=
+ cn[, choices <= rnk] <- x$CCA$centroids[, choices[choices <=
rnk]]
colnames(cn) <- c(colnames(x$CCA$u), colnames(x$CA$u))[choices]
rownames(cn) <- rownames(x$CCA$centroids)
@@ -93,14 +97,14 @@
## Take care that scores have names
if (length(sol)) {
for (i in seq_along(sol)) {
- if (is.matrix(sol[[i]]))
+ if (is.matrix(sol[[i]]))
rownames(sol[[i]]) <-
- rownames(sol[[i]], do.NULL = FALSE,
+ rownames(sol[[i]], do.NULL = FALSE,
prefix = substr(names(sol)[i], 1, 3))
}
}
## Only one type of scores: return a matrix instead of a list
- if (length(sol) == 1)
+ if (length(sol) == 1)
sol <- sol[[1]]
sol
}
Modified: pkg/vegan/R/scores.rda.R
===================================================================
--- pkg/vegan/R/scores.rda.R 2015-09-09 08:19:06 UTC (rev 2959)
+++ pkg/vegan/R/scores.rda.R 2015-09-15 07:23:30 UTC (rev 2960)
@@ -1,6 +1,6 @@
`scores.rda` <-
- function (x, choices = c(1, 2), display = c("sp", "wa", "cn"),
- scaling = 2, const, ...)
+ function (x, choices = c(1, 2), display = c("sp", "wa", "cn"),
+ scaling = "species", const, correlation = FALSE, ...)
{
## Check the na.action, and pad the result with NA or WA if class
## "exclude"
@@ -39,6 +39,10 @@
}
rnk <- x$CCA$rank
sol <- list()
+ ## check scaling for character & process it if so
+ if (is.character(scaling)) {
+ scaling <- scalingType(scaling = scaling, correlation = correlation)
+ }
if ("species" %in% take) {
v <- cbind(x$CCA$v, x$CA$v)[, choices, drop=FALSE]
if (scaling) {
Modified: pkg/vegan/R/summary.cca.R
===================================================================
--- pkg/vegan/R/summary.cca.R 2015-09-09 08:19:06 UTC (rev 2959)
+++ pkg/vegan/R/summary.cca.R 2015-09-15 07:23:30 UTC (rev 2960)
@@ -1,7 +1,7 @@
-`summary.cca` <-
- function (object, scaling = 2, axes = 6, display=c("sp","wa","lc","bp","cn"),
- digits = max(3, getOption("digits") - 3), ...)
-{
+`summary.cca` <- function (object, scaling = "species", axes = 6,
+ display=c("sp","wa","lc","bp","cn"),
+ digits = max(3, getOption("digits") - 3),
+ correlation = FALSE, hill = FALSE, ...) {
if (inherits(object, "pcaiv")) {
warning("this is an ade4 object which vegan cannot handle")
axes <- min(axes, object$nf)
@@ -9,8 +9,12 @@
}
axes <- min(axes, sum(object$CCA$rank, object$CA$rank))
summ <- list()
+ ## scaling is stored in return object so must be in numeric format
+ scaling <- scalingType(scaling = scaling, correlation = correlation,
+ hill = hill)
if (axes && length(display) && (!is.na(display) && !is.null(display)))
- summ <- scores(object, scaling = scaling, choices = 1:axes, display = display, ...)
+ summ <- scores(object, scaling = scaling, choices = 1:axes, display = display,
+ ...)
## scores() drops list to a matrix if there is only one item: workaround below.
if (!is.list(summ) && length(display) == 1) {
nms <- c("species", "sites", "constraints", "biplot", "centroids")
Modified: pkg/vegan/R/summary.prc.R
===================================================================
--- pkg/vegan/R/summary.prc.R 2015-09-09 08:19:06 UTC (rev 2959)
+++ pkg/vegan/R/summary.prc.R 2015-09-15 07:23:30 UTC (rev 2960)
@@ -1,8 +1,7 @@
-`summary.prc` <-
- function (object, axis = 1, scaling = 3, digits = 4, ...)
-{
+`summary.prc` <- function (object, axis = 1, scaling = "symmetric",
+ digits = 4, correlation = FALSE, ...) {
sc = scores(object, scaling = scaling, display = c("sp", "lc"),
- choices=axis, ...)
+ choices = axis, correlation = correlation, ...)
## coef for scaled sites (coef(object) gives for orthonormal)
b <- qr.coef(object$CCA$QR, sc$constraints)
prnk <- object$pCCA$rank
Modified: pkg/vegan/R/text.cca.R
===================================================================
--- pkg/vegan/R/text.cca.R 2015-09-09 08:19:06 UTC (rev 2959)
+++ pkg/vegan/R/text.cca.R 2015-09-15 07:23:30 UTC (rev 2960)
@@ -1,12 +1,13 @@
`text.cca` <-
- function (x, display = "sites", labels, choices = c(1, 2), scaling = 2,
- arrow.mul, head.arrow = 0.05, select, const, axis.bp = TRUE, ...)
+ function (x, display = "sites", labels, choices = c(1, 2), scaling = "species",
+ arrow.mul, head.arrow = 0.05, select, const, axis.bp = TRUE,
+ correlation = FALSE, hill = FALSE, ...)
{
formals(arrows) <- c(formals(arrows), alist(... = ))
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)
+ const, correlation = correlation, hill = hill)
## store rownames of pts for use later, otherwise if user supplies
## labels, the checks in "cn" branch fail and "bp" branch will
## be entered even if there should be no "bp" plotting
@@ -18,7 +19,7 @@
if (display == "cn") {
text(pts, labels = rownames(pts), ...)
pts <- scores(x, choices = choices, display = "bp", scaling = scaling,
- const)
+ const, correlation = correlation, hill = hill)
bnam <- rownames(pts)
pts <- pts[!(bnam %in% cnam), , drop = FALSE]
if (nrow(pts) == 0)
Modified: pkg/vegan/R/tolerance.cca.R
===================================================================
--- pkg/vegan/R/tolerance.cca.R 2015-09-09 08:19:06 UTC (rev 2959)
+++ pkg/vegan/R/tolerance.cca.R 2015-09-15 07:23:30 UTC (rev 2960)
@@ -10,7 +10,7 @@
##' @param which character; one of \code{"species"} or \code{"sites"},
##' indicating whether species tolerances or sample heterogeneities
##' respectively are computed.
-##' @param scaling numeric; the ordination scaling to use.
+##' @param scaling numeric or character; the ordination scaling to use.
##' @param useN2 logical; should the bias in the tolerances /
##' heterogeneities be reduced via scaling by Hill's N2?
##' @param ... arguments passed to other methods
@@ -25,7 +25,8 @@
##'
tolerance.cca <- function(x, choices = 1:2,
which = c("species","sites"),
- scaling = 2, useN2 = FALSE, ...) {
+ scaling = "species", useN2 = FALSE,
+ hill = FALSE, ...) {
if(inherits(x, "rda"))
stop("tolerances only available for unimodal ordinations")
if(missing(which))
@@ -40,8 +41,10 @@
x$rowsum %o% x$colsum) * x$grand.total
which <- match.arg(which)
siteScrTypes <- if(is.null(x$CCA)){ "sites" } else {"lc"}
+ ## Sort out scaling; only for (C)CA so no correlation arg
+ scaling <- scalingType(scaling, hill = hill)
scrs <- scores(x, display = c(siteScrTypes,"species"),
- choices = choices, scaling = scaling)
+ choices = choices, scaling = scaling, ...)
## compute N2 if useN2 == TRUE & only if
doN2 <- isTRUE(useN2) && ((which == "species" && abs(scaling) == 2) ||
(which == "sites" && abs(scaling) == 1))
Modified: pkg/vegan/man/biplot.rda.Rd
===================================================================
--- pkg/vegan/man/biplot.rda.Rd 2015-09-09 08:19:06 UTC (rev 2959)
+++ pkg/vegan/man/biplot.rda.Rd 2015-09-15 07:23:30 UTC (rev 2960)
@@ -6,9 +6,9 @@
Draws a PCA biplot with species scores indicated by biplot arrows
}
\usage{
-\method{biplot}{rda}(x, choices = c(1, 2), scaling = 2,
+\method{biplot}{rda}(x, choices = c(1, 2), scaling = "species",
display = c("sites", "species"), type, xlim, ylim, col = c(1,2),
- const, ...)
+ const, correlation = FALSE, ...)
}
\arguments{
@@ -21,7 +21,19 @@
scaling values in \code{rda}, species scores are divided by standard
deviation of each species and multiplied with an equalizing
constant. Unscaled raw scores stored in the result can be accessed
- with \code{scaling = 0}.}
+ with \code{scaling = 0}.
+
+ The type of scores can also be specified as one of \code{"none"},
+ \code{"sites"}, \code{"species"}, or \code{"symmetric"}, which
+ correspond to the values \code{0}, \code{1}, \code{2}, and \code{3}
+ respectively. Argument \code{correlation} can be used in combination
+ with these character descriptions to get the corresponding negative
+ value.
+ }
+ \item{correlation}{logical; if \code{scaling} is a character
+ description of the scaling type, \code{correlation} can be used to
+ select correlation-like scores for PCA. See argument \code{scaling}
+ for details.}
\item{display}{Scores shown. These must some of the alternatives
\code{"species"} for species scores, and/or \code{"sites"} for site
scores.}
@@ -68,9 +80,9 @@
\examples{
data(dune)
mod <- rda(dune, scale = TRUE)
-biplot(mod, scaling = 3)
+biplot(mod, scaling = "symmetric")
## different type for species and site scores
-biplot(mod, scaling = 3, type = c("text", "points"))
+biplot(mod, scaling = "symmetric", type = c("text", "points"))
}
\keyword{hplot}
Modified: pkg/vegan/man/plot.cca.Rd
===================================================================
--- pkg/vegan/man/plot.cca.Rd 2015-09-09 08:19:06 UTC (rev 2959)
+++ pkg/vegan/man/plot.cca.Rd 2015-09-15 07:23:30 UTC (rev 2960)
@@ -19,16 +19,22 @@
}
\usage{
\method{plot}{cca}(x, choices = c(1, 2), display = c("sp", "wa", "cn"),
- scaling = 2, type, xlim, ylim, const, ...)
-\method{text}{cca}(x, display = "sites", labels, choices = c(1, 2), scaling = 2,
- arrow.mul, head.arrow = 0.05, select, const, axis.bp = TRUE, ...)
-\method{points}{cca}(x, display = "sites", choices = c(1, 2), scaling = 2,
- arrow.mul, head.arrow = 0.05, select, const, axis.bp = TRUE, ...)
-\method{scores}{cca}(x, choices=c(1,2), display=c("sp","wa","cn"), scaling=2, ...)
-\method{scores}{rda}(x, choices=c(1,2), display=c("sp","wa","cn"), scaling=2,
- const, ...)
-\method{summary}{cca}(object, scaling = 2, axes = 6, display = c("sp", "wa",
- "lc", "bp", "cn"), digits = max(3, getOption("digits") - 3), ...)
+ scaling = "species", type, xlim, ylim, const,
+ correlation = FALSE, hill = FALSE, ...)
+\method{text}{cca}(x, display = "sites", labels, choices = c(1, 2),
+ scaling = "species", arrow.mul, head.arrow = 0.05, select, const,
+ axis.bp = TRUE, correlation = FALSE, hill = FALSE, ...)
+\method{points}{cca}(x, display = "sites", choices = c(1, 2),
+ scaling = "species", arrow.mul, head.arrow = 0.05, select, const,
+ axis.bp = TRUE, correlation = FALSE, hill = FALSE, ...)
+\method{scores}{cca}(x, choices = c(1,2), display = c("sp","wa","cn"),
+ scaling = "species", hill = FALSE, ...)
+\method{scores}{rda}(x, choices = c(1,2), display = c("sp","wa","cn"),
+ scaling = "species", const, correlation = FALSE, ...)
+\method{summary}{cca}(object, scaling = "species", axes = 6,
+ display = c("sp", "wa", "lc", "bp", "cn"),
+ digits = max(3, getOption("digits") - 3),
+ correlation = FALSE, hill = FALSE, ...)
\method{print}{summary.cca}(x, digits = x$digits, head = NA, tail = head, ...)
\method{head}{summary.cca}(x, n = 6, tail = 0, ...)
\method{tail}{summary.cca}(x, n = 6, head = 0, ...)
@@ -37,25 +43,36 @@
\arguments{
\item{x, object}{A \code{cca} result object.}
\item{choices}{Axes shown.}
- \item{display}{Scores shown. These must include some of the alternatives
- \code{species} or \code{sp} for species scores, \code{sites} or
- \code{wa} for site scores, \code{lc} for linear constraints or ``LC
- scores'', or \code{bp} for biplot arrows or \code{cn} for centroids
- of factor constraints instead of an arrow.}
- \item{scaling}{Scaling for species and site scores. Either species
+ \item{display}{Scores shown. These must include some of the
+ alternatives \code{species} or \code{sp} for species scores,
+ \code{sites} or \code{wa} for site scores, \code{lc} for linear
+ constraints or ``LC scores'', or \code{bp} for biplot arrows or
+ \code{cn} for centroids of factor constraints instead of an arrow.}
+ \item{scaling}{Scaling for species and site scores. Either species
(\code{2}) or site (\code{1}) scores are scaled by eigenvalues, and
the other set of scores is left unscaled, or with \code{3} both are
scaled symmetrically by square root of eigenvalues. Corresponding
negative values can be used in \code{cca} to additionally multiply
- results with \eqn{\sqrt(1/(1-\lambda))}. This scaling is know as
- Hill scaling (although it has nothing to do
- with Hill's rescaling of \code{\link{decorana}}). With corresponding
- negative values in\code{rda},
- species scores are divided by standard deviation of each species and
- multiplied with an equalizing constant.
- Unscaled raw scores stored in the result can be accessed with
- \code{scaling = 0}.
+ results with \eqn{\sqrt(1/(1-\lambda))}. This scaling is know as Hill
+ scaling (although it has nothing to do with Hill's rescaling of
+ \code{\link{decorana}}). With corresponding negative values
+ in\code{rda}, species scores are divided by standard deviation of each
+ species and multiplied with an equalizing constant. Unscaled raw
+ scores stored in the result can be accessed with \code{scaling = 0}.
+
+ The type of scores can also be specified as one of \code{"none"},
+ \code{"sites"}, \code{"species"}, or \code{"symmetric"}, which
+ correspond to the values \code{0}, \code{1}, \code{2}, and \code{3}
+ respectively. Arguments \code{correlation} and \code{hill} in
+ \code{scores.rda} and \code{scores.cca} respectively can be used in
+ combination with these character descriptions to get the
+ corresponding negative value.
}
+ \item{correlation, hill}{logical; if \code{scaling} is a character
+ description of the scaling type, \code{correlation} or \code{hill}
+ are used to select the corresponding negative scaling type; either
+ correlation-like scores or Hill's scaling for PCA/RDA and CA/CCA
+ respectively. See argument \code{scaling} for details.}
\item{type}{Type of plot: partial match to \code{text}
for text labels, \code{points} for points, and \code{none} for
setting frames only. If omitted, \code{text} is selected for
@@ -165,6 +182,14 @@
## Limited output of 'summary'
head(summary(mod), tail=2)
## Read description of scaling in RDA in vegan:
-\dontrun{vegandocs("decision")}}
+\dontrun{vegandocs("decision")}
+
+## Scaling can be numeric or more user-friendly names
+## e.g. Hill's scaling for (C)CA
+scrs <- scores(mod, scaling = "sites", hill = TRUE)
+## or correlation-based scores in PCA/RDA
+scrs <- scores(rda(dune ~ A1 + Moisture + Management, dune.env),
+ scaling = "sites", correlation = TRUE)
+}
\keyword{hplot}
\keyword{aplot}
Modified: pkg/vegan/man/prc.Rd
===================================================================
--- pkg/vegan/man/prc.Rd 2015-09-09 08:19:06 UTC (rev 2959)
+++ pkg/vegan/man/prc.Rd 2015-09-15 07:23:30 UTC (rev 2960)
@@ -17,10 +17,11 @@
\usage{
prc(response, treatment, time, ...)
-\method{summary}{prc}(object, axis = 1, scaling = 3, digits = 4, ...)
-\method{plot}{prc}(x, species = TRUE, select, scaling = 3, axis = 1, type = "l",
- xlab, ylab, ylim, lty = 1:5, col = 1:6, pch, legpos, cex = 0.8,
- ...)
+\method{summary}{prc}(object, axis = 1, scaling = "symmetric",
+ digits = 4, correlation = FALSE, ...)
+\method{plot}{prc}(x, species = TRUE, select, scaling = "symmetric",
+ axis = 1, correlation = FALSE, type = "l", xlab, ylab, ylim,
+ lty = 1:5, col = 1:6, pch, legpos, cex = 0.8, ...)
}
\arguments{
@@ -33,8 +34,20 @@
\item{object, x}{An \code{prc} result object.}
\item{axis}{Axis shown (only one axis can be selected).}
\item{scaling}{Scaling of species scores, identical to the
- \code{scaling} in \code{\link{scores.rda}}.}
+ \code{scaling} in \code{\link{scores.rda}}.
+
+ The type of scores can also be specified as one of \code{"none"},
+ \code{"sites"}, \code{"species"}, or \code{"symmetric"}, which
+ correspond to the values \code{0}, \code{1}, \code{2}, and \code{3}
+ respectively. Argument \code{correlation} can be used in combination
+ with these character descriptions to get the corresponding negative
+ value.
+ }
\item{digits}{Number of significant digits displayed.}
+ \item{correlation}{logical; if \code{scaling} is a character
+ description of the scaling type, \code{correlation} can be used to
+ select correlation-like scores for PCA. See argument \code{scaling}
+ for details.}
\item{species}{Display species scores.}
\item{select}{Vector to select displayed species. This can be a vector
of indices or a logical vector which is \code{TRUE} for the selected
Modified: pkg/vegan/man/predict.cca.Rd
===================================================================
--- pkg/vegan/man/predict.cca.Rd 2015-09-09 08:19:06 UTC (rev 2959)
+++ pkg/vegan/man/predict.cca.Rd 2015-09-15 07:23:30 UTC (rev 2960)
@@ -27,7 +27,11 @@
type = c("response", "working"), ...)
\method{residuals}{cca}(object, ...)
\method{predict}{cca}(object, newdata, type = c("response", "wa", "sp", "lc", "working"),
- rank = "full", model = c("CCA", "CA"), scaling = FALSE, ...)
+ rank = "full", model = c("CCA", "CA"), scaling = FALSE,
+ hill = FALSE, ...)
+\method{predict}{rda}(object, newdata, type = c("response", "wa", "sp", "lc", "working"),
+ rank = "full", model = c("CCA", "CA"), scaling = FALSE,
+ correlation = FALSE, ...)
\method{calibrate}{cca}(object, newdata, rank = "full", ...)
\method{coef}{cca}(object, ...)
\method{predict}{decorana}(object, newdata, type = c("response", "sites", "species"),
@@ -70,9 +74,13 @@
\item{rank}{The rank or the number of axes used in the approximation.
The default is to use all axes (full rank) of the \code{"model"} or
all available four axes in \code{predict.decorana}.}
- \item{scaling}{Scaling or predicted scores with the same meaning as
- in \code{\link{cca}}, \code{\link{rda}} and
- \code{\link{capscale}}.}
+ \item{scaling}{logical, character, or numeric; Scaling or predicted
+ scores with the same meaning as in \code{\link{cca}},
+ \code{\link{rda}} and \code{\link{capscale}}. See \code{scores.cca}
+ for further details on acceptable values.}
+ \item{correlation, hill}{logical; correlation-like scores or Hill's
+ scaling as appropriate for RDA/\code{\link{capscale}} and CCA
+ respectively. See \code{\link{scores.cca}} for additional details.}
\item{\dots}{Other parameters to the functions.}
}
\details{
Modified: pkg/vegan/man/tolerance.Rd
===================================================================
--- pkg/vegan/man/tolerance.Rd 2015-09-09 08:19:06 UTC (rev 2959)
+++ pkg/vegan/man/tolerance.Rd 2015-09-15 07:23:30 UTC (rev 2960)
@@ -7,7 +7,7 @@
tolerance(x, \dots)
\method{tolerance}{cca}(x, choices = 1:2, which = c("species","sites"),
- scaling = 2, useN2 = FALSE, \dots)
+ scaling = "species", useN2 = FALSE, hill = FALSE, \dots)
}
\description{
Species tolerances and sample heterogeneities.
@@ -29,7 +29,11 @@
\item{which}{character; one of \code{"species"} or \code{"sites"},
indicating whether species tolerances or sample heterogeneities
respectively are computed.}
- \item{scaling}{numeric; the ordination scaling to use.}
+ \item{scaling}{character or numeric; the ordination scaling to
+ use. See \code{\link{scores.cca}} for details.}
+ \item{hill}{logical; if \code{scaling} is a character,
+ these control whether Hill's scaling is used for (C)CA
+ respectively. See \code{\link{scores.cca}} for details.}
\item{useN2}{logical; should the bias in the tolerances /
heterogeneities be reduced via scaling by Hill's N2?}
\item{\dots}{arguments passed to other methods.}
More information about the Vegan-commits
mailing list