[Vegan-commits] r2964 - in pkg/vegan: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Sep 21 08:37:06 CEST 2015
Author: jarioksa
Date: 2015-09-21 08:37:06 +0200 (Mon, 21 Sep 2015)
New Revision: 2964
Modified:
pkg/vegan/DESCRIPTION
pkg/vegan/R/predict.cca.R
pkg/vegan/R/predict.rda.R
pkg/vegan/R/scalingUtils.R
pkg/vegan/R/scores.cca.R
pkg/vegan/R/scores.rda.R
pkg/vegan/man/predict.cca.Rd
Log:
Merge branch 'cran-2.3' into r-forge-svn-local
Modified: pkg/vegan/DESCRIPTION
===================================================================
--- pkg/vegan/DESCRIPTION 2015-09-17 10:05:29 UTC (rev 2963)
+++ pkg/vegan/DESCRIPTION 2015-09-21 06:37:06 UTC (rev 2964)
@@ -1,7 +1,7 @@
Package: vegan
Title: Community Ecology Package
Version: 2.3-1
-Date: 2015-05-28
+Date: 2015-09-18
Author: Jari Oksanen, F. Guillaume Blanchet, Roeland Kindt, Pierre Legendre,
Peter R. Minchin, R. B. O'Hara, Gavin L. Simpson, Peter Solymos,
M. Henry H. Stevens, Helene Wagner
Modified: pkg/vegan/R/predict.cca.R
===================================================================
--- pkg/vegan/R/predict.cca.R 2015-09-17 10:05:29 UTC (rev 2963)
+++ pkg/vegan/R/predict.cca.R 2015-09-21 06:37:06 UTC (rev 2964)
@@ -1,6 +1,6 @@
`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 = "none",
hill = FALSE, ...)
{
type <- match.arg(type)
@@ -21,12 +21,8 @@
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)
- }
+ ## process scaling arg, scaling used later so needs to be a numeric
+ scaling <- scalingType(scaling = scaling, hill = hill)
if (type %in% c("response", "working")) {
Xbar <- 0
if (!missing(newdata)) {
@@ -63,7 +59,7 @@
u <- u[, 1:take, drop = FALSE]
}
out <- u
- if (scaling) {
+ if (scaling) { # implicit conversion "none" == 0 == FALSE
scal <- list(diag(slam), 1, sqrt(diag(slam)))[[abs(scaling)]]
out <- sweep(out, 2, scal, "*")
if (scaling < 0) {
@@ -94,7 +90,7 @@
w <- sweep(w, 2, diag(slam), "/")
}
out <- w
- if (scaling) {
+ if (scaling) { # implicit conversion "none" == 0 == FALSE
scal <- list(diag(slam), 1, sqrt(diag(slam)))[[abs(scaling)]]
out <- sweep(out, 2, scal, "*")
if (scaling < 0) {
@@ -121,7 +117,7 @@
v <- sweep(v, 2, diag(slam), "/")
}
out <- v
- if (scaling) {
+ if (scaling) { # implicit conversion "none" == 0 == FALSE
scal <- list(1, diag(slam), sqrt(diag(slam)))[[abs(scaling)]]
out <- sweep(out, 2, scal, "*")
if (scaling < 0) {
Modified: pkg/vegan/R/predict.rda.R
===================================================================
--- pkg/vegan/R/predict.rda.R 2015-09-17 10:05:29 UTC (rev 2963)
+++ pkg/vegan/R/predict.rda.R 2015-09-21 06:37:06 UTC (rev 2964)
@@ -1,6 +1,6 @@
`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 = "none",
correlation = FALSE, ...)
{
type <- match.arg(type)
@@ -25,12 +25,8 @@
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)
- }
+ ## process scaling arg, scaling used later so needs to be a numeric
+ 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",
@@ -82,7 +78,7 @@
u <- u[, 1:take, drop = FALSE]
}
out <- u
- if (scaling) {
+ if (scaling) { # implicit coercion 0 == FALSE, other == TRUE
tot <- sqrt(object$tot.chi * nr)
lam <- list(diag(slam)/tot, 1, sqrt(diag(slam)/tot))[[abs(scaling)]]
out <- sqrt(tot) * sweep(out, 2, lam, "*")
@@ -110,7 +106,7 @@
w <- sweep(w, 2, diag(slam), "/")
}
out <- w
- if (scaling) {
+ if (scaling) { # implicit coercion 0 == FALSE, other == TRUE
tot <- sqrt(object$tot.chi * nr)
lam <- list(diag(slam)/tot, 1, sqrt(diag(slam)/tot))[[abs(scaling)]]
out <- sqrt(tot) * sweep(out, 2, lam, "*")
@@ -134,7 +130,7 @@
v <- sweep(v, 2, diag(slam), "/")
}
out <- v
- if (scaling) {
+ if (scaling) { # implicit coercion 0 == FALSE, other == TRUE
tot <- sqrt(object$tot.chi * nr)
scal <- list(1, diag(slam)/tot, sqrt(diag(slam)/tot))[[abs(scaling)]]
out <- sqrt(tot) * sweep(out, 2, scal, "*")
Modified: pkg/vegan/R/scalingUtils.R
===================================================================
--- pkg/vegan/R/scalingUtils.R 2015-09-17 10:05:29 UTC (rev 2963)
+++ pkg/vegan/R/scalingUtils.R 2015-09-21 06:37:06 UTC (rev 2964)
@@ -2,21 +2,26 @@
##'
##' @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 scaling character or numeric; which type of scaling is required? Numeric values are returned unaltered
##' @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)
-{
- ## numeric scaling: return as-is
- if (is.numeric(scaling))
- return(scaling)
- ## non-numeric scaling: change to numeric
- 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
+ correlation = FALSE, hill = FALSE) {
+ ## Only process scaling further if it is character
+ if (is.numeric(scaling)) {
+ return(scaling) # numeric; return early
+ } else if (is.character(scaling)) {
+ ## non-numeric scaling: change to correct numeric code
+ scaling <- match.arg(scaling) # match user choice
+ ## Keep `tab` as this is the order of numeric codes
+ ## Allows potential to change the default ordering of formal argument 'scaling'
+ tab <- c("none", "sites", "species", "symmetric")
+ scaling <- match(scaling, tab) - 1 # -1 as none == scaling 0
+ if (correlation || hill) {
+ scaling <- -scaling
+ }
+ } else {
+ stop("'scaling' is not 'numeric' nor 'character'.")
}
- scl # return
+ scaling # return
}
Modified: pkg/vegan/R/scores.cca.R
===================================================================
--- pkg/vegan/R/scores.cca.R 2015-09-17 10:05:29 UTC (rev 2963)
+++ pkg/vegan/R/scores.cca.R 2015-09-21 06:37:06 UTC (rev 2964)
@@ -26,10 +26,8 @@
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)
- }
+ ## process scaling; numeric scaling will just be returned as is
+ scaling <- scalingType(scaling = scaling, hill = hill)
if ("species" %in% take) {
v <- cbind(x$CCA$v, x$CA$v)[, choices, drop = FALSE]
if (scaling) {
Modified: pkg/vegan/R/scores.rda.R
===================================================================
--- pkg/vegan/R/scores.rda.R 2015-09-17 10:05:29 UTC (rev 2963)
+++ pkg/vegan/R/scores.rda.R 2015-09-21 06:37:06 UTC (rev 2964)
@@ -39,10 +39,8 @@
}
rnk <- x$CCA$rank
sol <- list()
- ## check scaling for character & process it if so
- if (is.character(scaling)) {
- scaling <- scalingType(scaling = scaling, correlation = correlation)
- }
+ ## process scaling; numeric scaling will just be returned as is
+ 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/man/predict.cca.Rd
===================================================================
--- pkg/vegan/man/predict.cca.Rd 2015-09-17 10:05:29 UTC (rev 2963)
+++ pkg/vegan/man/predict.cca.Rd 2015-09-21 06:37:06 UTC (rev 2964)
@@ -27,10 +27,10 @@
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 = "none",
hill = FALSE, ...)
\method{predict}{rda}(object, newdata, type = c("response", "wa", "sp", "lc", "working"),
- rank = "full", model = c("CCA", "CA"), scaling = FALSE,
+ rank = "full", model = c("CCA", "CA"), scaling = "none",
correlation = FALSE, ...)
\method{calibrate}{cca}(object, newdata, rank = "full", ...)
\method{coef}{cca}(object, ...)
More information about the Vegan-commits
mailing list