[Vegan-commits] r1710 - in branches/1.17: R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Aug 10 20:05:38 CEST 2011
Author: jarioksa
Date: 2011-08-10 20:05:38 +0200 (Wed, 10 Aug 2011)
New Revision: 1710
Added:
branches/1.17/R/tolerance.R
branches/1.17/R/tolerance.cca.R
branches/1.17/man/tolerance.Rd
Modified:
branches/1.17/inst/ChangeLog
Log:
copy tolerance[.cca].R to 1.17-12
Copied: branches/1.17/R/tolerance.R (from rev 1709, pkg/vegan/R/tolerance.R)
===================================================================
--- branches/1.17/R/tolerance.R (rev 0)
+++ branches/1.17/R/tolerance.R 2011-08-10 18:05:38 UTC (rev 1710)
@@ -0,0 +1,8 @@
+##' S3 generic for function to compute tolerances
+##'
+##' Brought this in here from analogue because of tolerance.cca
+##'
+##' @param x an R object
+##' @param ... arguments passed to other methods
+`tolerance` <- function(x, ...)
+ UseMethod("tolerance")
Copied: branches/1.17/R/tolerance.cca.R (from rev 1709, pkg/vegan/R/tolerance.cca.R)
===================================================================
--- branches/1.17/R/tolerance.cca.R (rev 0)
+++ branches/1.17/R/tolerance.cca.R 2011-08-10 18:05:38 UTC (rev 1710)
@@ -0,0 +1,94 @@
+##' Species tolerances and sample heterogeneities
+##'
+##' Function to compute species tolerances and site heterogeneity measures
+##' from unimodal ordinations (CCA & CA). Implements Eq 6.47 and 6.48 from
+##' the Canoco 4.5 Reference Manual (pages 178-179).
+##'
+##' @param x object of class \code{"cca"}.
+##' @param choices numeric; which ordination axes to compute
+##' tolerances and heterogeneities for. Defaults to axes 1 and 2.
+##' @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 useN2 logical; should the bias in the tolerances /
+##' heterogeneities be reduced via scaling by Hill's N2?
+##' @param ... arguments passed to other methods
+##' @return matrix of tolerances/heterogeneities with some additional
+##' attributes.
+##' @author Gavin Simpson \email{gavin.simpson AT ucl.ac.uk}
+##' @examples
+##' data(dune)
+##' data(dune.env)
+##' mod <- cca(dune ~ ., data = dune.env)
+##' tolerance.cca(mod)
+##'
+tolerance.cca <- function(x, choices = 1:2,
+ which = c("species","sites"),
+ scaling = 2, useN2 = FALSE, ...) {
+ if(inherits(x, "rda"))
+ stop("Tolerances only available for unimodal ordinations.")
+ if(missing(which))
+ which <- "species"
+ ## reconstruct species/response matrix Y - up to machine precision!
+ partialFit <- ifelse(is.null(x$pCCA$Fit), 0, x$pCCA$Fit)
+ Y <- ((partialFit + x$CCA$Xbar) * sqrt(x$rowsum %o% x$colsum) +
+ x$rowsum %o% x$colsum) * x$grand.total
+ which <- match.arg(which)
+ siteScrTypes <- if(is.null(x$CCA)){ "sites" } else {"lc"}
+ scrs <- scores(x, display = c(siteScrTypes,"species"),
+ choices = choices, scaling = scaling)
+ ## compute N2 if useN2 == TRUE & only if
+ doN2 <- isTRUE(useN2) && ((which == "species" && abs(scaling) == 2) ||
+ (which == "sites" && abs(scaling) == 1))
+
+ ## this gives the x_i - u_k on axis j
+ ## outer(scrs$sites, scrs$species, "-")[,2,,j]
+ siteScrs <- which(names(scrs) %in% c("sites","constraints"))
+ xiuk <- outer(scrs[[siteScrs]], scrs$species, "-")
+ if(isTRUE(all.equal(which, "sites"))) {
+ ## need to permute the array as rowSums has different idea of what rows
+ ## are that doesn't correspond to colSums. So flip dimensions 1 and 2
+ ## with aperm and use colSums.
+ res <- sqrt(sweep(colSums(aperm(sweep(xiuk[ , 2, , choices]^2, c(1:2),
+ data.matrix(Y), "*"),
+ c(2,1,3))),
+ 1, rowSums(Y), "/"))
+ if(doN2) {
+ tot <- rowSums(Y)
+ y <- sweep(Y, 1, tot, "/")^2
+ N2 <- 1 / rowSums(y, na.rm = TRUE) ## 1/H
+ res <- sweep(res, 1, sqrt(1 - (1/N2)), "/")
+ }
+ } else {
+ res <- sqrt(sweep(colSums(sweep(xiuk[ , 2, , choices]^2, c(1:2),
+ data.matrix(Y), "*")),
+ 1, colSums(Y), "/"))
+ if(doN2) {
+ tot <- colSums(Y)
+ y <- sweep(Y, 2, tot, "/")^2
+ N2 <- 1 / colSums(y, na.rm = TRUE) ## 1/H
+ res <- sweep(res, 1, sqrt(1 - (1/N2)), "/")
+ }
+ }
+ class(res) <- c("tolerance.cca","tolerance","matrix")
+ attr(res, "which") <- which
+ attr(res, "scaling") <- scaling
+ attr(res, "N2") <- NULL
+ if(doN2)
+ attr(res, "N2") <- N2
+ attr(res, "model") <- deparse(substitute(mod))
+ return(res)
+}
+
+`print.tolerance.cca` <- function(x, ...) {
+ cat("\n")
+ msg <- ifelse(attr(x, "which") == "species", "Species Tolerances",
+ "Sample Heterogeneities")
+ writeLines(strwrap(msg, prefix = "\t"), sep = "\n\n")
+ msg <- paste("Scaling:", attr(x, "scaling"))
+ writeLines(strwrap(msg), sep = "\n\n")
+ attr(x, "model") <- attr(x, "scaling") <- attr(x, "which") <- NULL
+ print(unclass(x), ...)
+ cat("\n")
+}
Modified: branches/1.17/inst/ChangeLog
===================================================================
--- branches/1.17/inst/ChangeLog 2011-08-10 15:48:21 UTC (rev 1709)
+++ branches/1.17/inst/ChangeLog 2011-08-10 18:05:38 UTC (rev 1710)
@@ -8,9 +8,11 @@
1634). Basically everything except 'permute' dependence and
monoMDS. Also adds the minimal NAMESPACE file of 1695 (without S3
method registration and later revs).
+ * tolerance (generic), tolerance.cca: copy from devel at 1558.
* merged 1704: better axis limits in plot.envfit to allow space
for vector and centroid labels.
- * partially merged 1700: model.{frame,matrix}.cca scoping.
+ * partially merged 1700: model.{frame,matrix}.cca scoping,
+ tolerance.Rd.
* merged 1699: ade2vegancca typo.
* partially merged r1696: superfluous aliases in deviance.cca.Rd
and predict.cca.Rd, scoping in anova.ccabyterm.R.
Copied: branches/1.17/man/tolerance.Rd (from rev 1709, pkg/vegan/man/tolerance.Rd)
===================================================================
--- branches/1.17/man/tolerance.Rd (rev 0)
+++ branches/1.17/man/tolerance.Rd 2011-08-10 18:05:38 UTC (rev 1710)
@@ -0,0 +1,47 @@
+\name{tolerance}
+\alias{tolerance}
+\alias{tolerance.cca}
+\alias{print.tolerance.cca}
+\title{Species tolerances and sample heterogeneities}
+\usage{
+tolerance(x, \dots)
+
+\method{tolerance}{cca}(x, choices = 1:2, which = c("species","sites"),
+ scaling = 2, useN2 = FALSE, \dots)
+}
+\description{
+ Species tolerances and sample heterogeneities.
+}
+\details{
+ Function to compute species tolerances and site heterogeneity measures
+ from unimodal ordinations (CCA & CA). Implements Eq 6.47 and 6.48 from
+ the Canoco 4.5 Reference Manual (pages 178-179).
+}
+\value{
+ Matrix of tolerances/heterogeneities with some additional
+ attributes.
+}
+\author{Gavin L. Simpson}
+\arguments{
+ \item{x}{object of class \code{"cca"}.}
+ \item{choices}{numeric; which ordination axes to compute
+ tolerances and heterogeneities for. Defaults to axes 1 and 2.}
+ \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{useN2}{logical; should the bias in the tolerances /
+ heterogeneities be reduced via scaling by Hill's N2?}
+ \item{\dots}{arguments passed to other methods.}
+}
+\examples{
+data(dune)
+data(dune.env)
+mod <- cca(dune ~ ., data = dune.env)
+
+## defaults to species tolerances
+tolerance(mod)
+
+## sample heterogeneities for CCA axes 1:6
+tolerance(mod, which = "sites", choices = 1:6)
+}
More information about the Vegan-commits
mailing list