[Vegan-commits] r2886 - in pkg/vegan: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Sep 22 10:38:01 CEST 2014
Author: jarioksa
Date: 2014-09-22 10:38:01 +0200 (Mon, 22 Sep 2014)
New Revision: 2886
Removed:
pkg/vegan/R/ccanova.R
pkg/vegan/R/ccanova.byaxis.R
pkg/vegan/R/ccanova.bymargin.R
pkg/vegan/R/ccanova.byterm.R
pkg/vegan/man/ccanova.Rd
Modified:
pkg/vegan/NAMESPACE
pkg/vegan/man/oecosimu.Rd
Log:
Squashed commit of the following:
commit 0d5ef1f29a292811865ff007aa6611b80e533663
Merge: ad80935 8f56476
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date: Mon Sep 22 08:33:05 2014 +0300
Merge remote-tracking branch 'upstream/master'
commit ad809359a6ffd9b4497503a02360602a4f8f7874
Author: Gavin Simpson <ucfagls at gmail.com>
Date: Sun Sep 21 15:39:49 2014 -0600
fix a typo
commit f25f30c479d1fec51cccd48b0a2b8941703744da
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date: Sun Aug 31 20:18:42 2014 +0300
Delete ccanova* in favour of anova.cca*
When anova.cca* switched to parallel processing, the old code was
backed up as ccanova* functions. Now these functions were removed
and only the new anova.cca* functions remain
commit 8f56476067432f58a1d8c739f017ddf69c8755e1
Merge: 272e918 413dcb6
Author: Gavin Simpson <ucfagls at gmail.com>
Date: Sun Sep 21 19:00:36 2014 -0600
Merge pull request #41 from jarioksa/parallel
Delete ccanova* in favour of anova.cca*
commit 272e918baaa57b35c2bcd5f50e4406e41cde00d9
Author: Gavin Simpson <ucfagls at gmail.com>
Date: Sun Sep 21 15:39:49 2014 -0600
fix a typo
commit e3a3fa09c073ad1a3b9e196a6031b04e4388cf9a
Merge: 793a0c7 b330bbd
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date: Thu Sep 18 16:49:51 2014 +0300
Merge pull request #40 from jarioksa/update-docs
Update docs
commit b330bbd01c877df5c44d48b49191362cc2bf2b71
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date: Wed Sep 17 21:22:22 2014 +0300
edit FAQ-vegan
commit 8494bb8c3cf81612c5baa72fdf086253703f9854
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date: Tue Sep 16 20:00:09 2014 +0300
remove svn-specific fields $Date$ and $Id$ from documents
commit 72009ede68c919e31569830dd51fa5c27fe9ca82
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date: Tue Sep 16 19:52:52 2014 +0300
More fixes for permutation routines in intro-vegan
commit d0b929423a483b32fc8bfa15bab6ced80b21aa0c
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date: Tue Sep 16 19:50:02 2014 +0300
FAQ-vegan adapted to GitHub
commit ec8fd7e0c27a3f57024fefca3840c19d990c54f5
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date: Tue Sep 16 19:34:56 2014 +0300
FAQ-vegan update to the use of permute package
commit bfb0f79a7a5cb1658c8509e94d8014b01dd24e09
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date: Tue Sep 16 19:20:00 2014 +0300
update intro-vegan to changes in anova.cca
commit 413dcb6b5853755c1b8a2c6f90e8c201a31d492d
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date: Sun Aug 31 20:18:42 2014 +0300
Delete ccanova* in favour of anova.cca*
When anova.cca* switched to parallel processing, the old code was
backed up as ccanova* functions. Now these functions were removed
and only the new anova.cca* functions remain
Modified: pkg/vegan/NAMESPACE
===================================================================
--- pkg/vegan/NAMESPACE 2014-09-18 13:57:33 UTC (rev 2885)
+++ pkg/vegan/NAMESPACE 2014-09-22 08:38:01 UTC (rev 2886)
@@ -29,8 +29,6 @@
treedist, treedive, treeheight, tsallisaccum, tsallis, varpart,
vectorfit, vegandocs, vegdist, vegemite, veiledspec, wascores,
wcmdscale, wisconsin)
-## Export temporary function later intended to replace anova.cca()
-export(ccanova) ## <-- REMOVE THIS WHEN ccanova IS REMOVED <--!!!
## export pasteCall for 'permute'
export(pasteCall)
## export anova.cca for 'BiodiversityR': this should be fixed there
Deleted: pkg/vegan/R/ccanova.R
===================================================================
--- pkg/vegan/R/ccanova.R 2014-09-18 13:57:33 UTC (rev 2885)
+++ pkg/vegan/R/ccanova.R 2014-09-22 08:38:01 UTC (rev 2886)
@@ -1,62 +0,0 @@
-`ccanova` <-
- function (object, alpha = 0.05, beta = 0.01, step = 100, perm.max = 9999,
- by = NULL, ...)
-{
- if (is.null(object$CA) || is.null(object$CCA) ||
- object$CCA$rank == 0 || object$CA$rank == 0)
- return(anova.ccanull(object))
- perm.max <- max(step-1, perm.max)
- if (perm.max %% step == 0)
- perm.max <- perm.max - 1
- if (!is.null(by)) {
- by <- match.arg(by, c("axis", "terms", "margin"))
- if (by == "axis")
- sol <- ccanova.byaxis(object, alpha = alpha, beta = beta,
- step = step, perm.max = perm.max, by = NULL,
- ...)
- else if (by == "margin") {
- sol <- ccanova.bymargin(object, alpha = alpha, beta = beta,
- step = step, perm.max = perm.max,
- by = NULL, ...)
- }
- else {
- mf <- match.call(expand.dots = FALSE)
- if (!is.null(mf$...) && any(k <- pmatch(names(mf$...),
- "permutations", nomatch = FALSE)))
- step <- unlist(mf$...[k == 1])
- sol <- ccanova.byterm(object, step = step, ...)
- }
- return(sol)
- }
- seed <- NULL
- betaq <- c(beta/2, 1 - beta/2)
- nperm <- 0
- unsure <- TRUE
- hits <- 0
- while (unsure && nperm < perm.max) {
- adj <- as.numeric(nperm == 0)
- tst <- permutest.cca(object, step - adj, ...)
- if (is.null(seed))
- seed <- tst$Random.seed
- nperm <- nperm + step - adj
- hits <- hits + sum(tst$F.perm >= tst$F.0)
- fork <- qbinom(betaq, nperm, alpha)
- if (hits < fork[1] || hits > fork[2])
- unsure <- FALSE
- }
- Fval <- c(tst$F.0, NA)
- Pval <- c((hits+1)/(nperm+1), NA)
- nperm <- c(nperm, NA)
- table <- data.frame(tst$df, tst$chi, Fval, nperm, Pval)
- is.rda <- inherits(object, "rda")
- colnames(table) <- c("Df", ifelse(is.rda, "Var", "Chisq"),
- "F", "N.Perm", "Pr(>F)")
- head <- paste("Permutation test for", tst$method, "under",
- tst$model, "model\n")
- if (!is.null(tst$strata))
- head <- paste(head, "Permutations stratified within '",
- tst$strata, "'\n", sep = "")
- mod <- paste("Model:", c(object$call))
- structure(table, heading = c(head, mod), Random.seed = seed,
- class = c("anova.cca", "anova", "data.frame"))
-}
Deleted: pkg/vegan/R/ccanova.byaxis.R
===================================================================
--- pkg/vegan/R/ccanova.byaxis.R 2014-09-18 13:57:33 UTC (rev 2885)
+++ pkg/vegan/R/ccanova.byaxis.R 2014-09-22 08:38:01 UTC (rev 2886)
@@ -1,89 +0,0 @@
-`ccanova.byaxis` <-
- function (object, cutoff = 1, ...)
-{
- cutoff <- cutoff + sqrt(.Machine$double.eps)
- rnk <- object$CCA$rank
- if (!max(rnk, 0))
- stop("Needs a constrained ordination")
- if (is.null(object$terms))
- stop("Analysis is only possible for models fitted using formula")
- ## Handle missing values in scores, both "omit" and "exclude" to
- ## match dims with data.
- if (!is.null(object$na.action)) {
- u <- napredict(structure(object$na.action, class="exclude"),
- object$CCA$u)
- } else {
- u <- object$CCA$u
- }
- ## Get conditions
- if (!is.null(object$pCCA)) {
- CondMat <- qr.X(object$pCCA$QR)
- ## deweight if CCA
- if (!inherits(object, "rda"))
- CondMat <- sweep(CondMat, 1, sqrt(object$rowsum), "/")
- }
- else
- CondMat <- NULL
- ## pad with NA rows if there is a subset
- if (!is.null(object$subset)) {
- lc <- matrix(NA, nrow=length(object$subset),
- ncol = NCOL(u))
- lc[object$subset,] <- u
- if (!is.null(CondMat)) {
- tmp <- matrix(NA, nrow=length(object$subset),
- ncol = NCOL(CondMat))
- tmp[object$subset,] <- CondMat
- CondMat <- tmp
- }
- object$call$subset <- object$subset
- } else {
- lc <- u
- }
- lc <- as.data.frame(lc)
- axnam <- colnames(lc)
- df <- c(rep(1, rnk), object$CA$rank)
- chi <- c(object$CCA$eig, Residual = object$CA$tot.chi)
- Fval <- c(chi[1:rnk]/df[1:rnk]/chi[rnk+1]*df[rnk+1], NA)
- nperm <- c(numeric(rnk), NA)
- Pval <- rep(NA, rnk+1)
- out <- data.frame(df, chi, Fval, nperm, Pval)
- environment(object$terms) <- environment()
- fla <- paste(". ~ ", axnam[1], "+ Condition(",
- paste(axnam[-1], collapse="+"),")")
- if (!is.null(CondMat)) {
- fla <- paste(fla, " + Condition(CondMat)")
- lc$CondMat <- CondMat
- }
- fla <- update(formula(object), fla)
- sol <- ccanova(update(object, fla, data=lc), ...)
- out[c(1, rnk + 1), ] <- sol
- seed <- attr(sol, "Random.seed")
- attr(out, "names") <- attr(sol, "names")
- .call <- pasteCall(object$call, "Model:")
- attr(out, "heading") <- sub(" \n","", .call)
- attr(out, "Random.seed") <- seed
- bigseed <- get(".Random.seed", envir = .GlobalEnv, inherits = FALSE)
- bigperm <- out$N.Perm[1]
- if (rnk > 1) {
- for (.ITRM in 2:rnk) {
- fla <- paste(".~", axnam[.ITRM], "+Condition(",
- paste(axnam[-(.ITRM)], collapse="+"),")")
- if (!is.null(CondMat))
- fla <- paste(fla, "+ Condition(CondMat)")
- fla <- update(formula(object), fla)
- sol <- update(object, fla, data = lc)
- assign(".Random.seed", seed, envir = .GlobalEnv)
- out[.ITRM, ] <- as.matrix(ccanova(sol, ...))[1,]
- if (out[.ITRM, "N.Perm"] > bigperm) {
- bigperm <- out[.ITRM, "N.Perm"]
- bigseed <- get(".Random.seed", envir = .GlobalEnv,
- inherits = FALSE)
- }
- if (out[.ITRM, "Pr(>F)"] > cutoff)
- break
- }
- }
- assign(".Random.seed", bigseed, envir = .GlobalEnv)
- class(out) <- c("anova.cca", "anova", "data.frame")
- out
-}
Deleted: pkg/vegan/R/ccanova.bymargin.R
===================================================================
--- pkg/vegan/R/ccanova.bymargin.R 2014-09-18 13:57:33 UTC (rev 2885)
+++ pkg/vegan/R/ccanova.bymargin.R 2014-09-22 08:38:01 UTC (rev 2886)
@@ -1,52 +0,0 @@
-`ccanova.bymargin` <-
- function(object, step=100, scope, ...)
-{
- if(inherits(object, "prc"))
- stop("ccanova(..., by = 'margin') cannot be used for 'prc' results")
- if (!missing(scope) && is.character(scope))
- trms <- scope
- else
- trms <- drop.scope(object, scope)
- alltrms <- labels(terms(object$terminfo))
- keep <- trms %in% alltrms
- trms <- trms[keep]
- ntrms <- length(trms)
- bigperm <- 0
- for (.ITRM in 1:ntrms) {
- fla <- formula(object)
- ## Put all trms except current into Condition() and update
- ## formula
- if (length(alltrms) > 1) {
- keeptrms <- alltrms[!(alltrms==trms[.ITRM])]
- updfla <- paste("Condition(",paste(keeptrms, collapse="+"), ")")
- fla <- update(fla, paste(". ~ . + ", updfla))
- }
- tmp <- update(object, fla)
- tmp <- ccanova(tmp, step=step, ...)
- ## Start every permutation from the same seed, but get the
- ## seed of the longest simulation and reset the RNG to that
- ## state when exiting the function
- if (tmp[1,"N.Perm"] > bigperm) {
- bigperm <- tmp[1, "N.Perm"]
- bigseed <- get(".Random.seed", envir = .GlobalEnv,
- inherits = FALSE)
- }
- if (.ITRM == 1) {
- seed <- attr(tmp, "Random.seed")
- sol <- tmp
- }
- else {
- sol <- rbind(sol[1:(.ITRM-1),], as.matrix(tmp[1,]), sol[.ITRM,])
- }
- assign(".Random.seed", seed, envir = .GlobalEnv)
- }
- ## Put RNG at the end of the longest simulation
- if (bigperm > 0)
- assign(".Random.seed", bigseed, envir = .GlobalEnv)
- rownames(sol)[1:ntrms] <- trms
- head <- attr(sol, "heading")
- head[1] <- paste(head[1], "Marginal effects of terms\n", sep="")
- head[2] <- paste("Model:", c(object$call))
- attr(sol, "heading") <- head
- sol
-}
Deleted: pkg/vegan/R/ccanova.byterm.R
===================================================================
--- pkg/vegan/R/ccanova.byterm.R 2014-09-18 13:57:33 UTC (rev 2885)
+++ pkg/vegan/R/ccanova.byterm.R 2014-09-22 08:38:01 UTC (rev 2886)
@@ -1,78 +0,0 @@
-`ccanova.byterm` <-
- function (object, step = 100, ...)
-{
- ## Data set size may change during iteration if there are missing
- ## values: use length(object$residual) to check this like step,
- ## drop1.default, add1.default do.
- n0 <- length(object$residuals)
- trm <- terms(object)
- call <- paste("Model:", c(object$call))
- trmlab <- attr(trm, "term.labels")
- trmlab <- trmlab[trmlab %in% attr(terms(object$terminfo),
- "term.labels")]
- ntrm <- length(trmlab)
- ## 'adj' puts the result together with the permutations and reduces
- ## number of simulations by one so that P = (hits+1)/(permutations+1).
- ## The first step is reduced by adj.
- adj <- (step %% 10) == 0
- step <- step - adj
- pchi <- matrix(0, nrow = ntrm + 1, ncol = step)
- chi <- numeric(ntrm + 1)
- df <- numeric(ntrm + 1)
- names(df) <- c(trmlab, "Residual")
- sim <- permutest.cca(object, permutations = step, ...)
- pchi[ntrm + 1, ] <- sim$den
- pchi[ntrm, ] <- sim$num
- df[ntrm:(ntrm + 1)] <- sim$df
- chi[ntrm:(ntrm + 1)] <- sim$chi
- if (!is.null(object$call$data))
- modelframe <- ordiGetData(object$call, globalenv())
- else
- modelframe <- model.frame(object)
- for (.ITRM in ntrm:2) {
- if (ntrm < 2)
- break
- assign(".Random.seed", sim$Random.seed, envir = .GlobalEnv)
- fla <- as.formula(paste(" . ~ . -", trmlab[.ITRM]))
- object <- update(object, fla,
- if (!is.null(modelframe)) data = modelframe)
- ## Change in data set due to missing values?
- if (length(object$residuals) != n0)
- stop("number of rows has changed: remove missing values?")
- if (is.null(object$CCA))
- break
- sim <- permutest.cca(object, permutations = step, ...)
- pchi[.ITRM, ] <- pchi[.ITRM, ] - sim$num
- chi[.ITRM] <- chi[.ITRM] - sim$chi[1]
- df[.ITRM] <- df[.ITRM] - sim$df[1]
- pchi[.ITRM - 1, ] <- sim$num
- chi[.ITRM - 1] <- sim$chi[1]
- df[.ITRM - 1] <- sim$df[1]
- }
- Fval <- chi/df/(chi[ntrm + 1]/df[ntrm + 1])
- Fval[ntrm + 1] <- NA
- pchi <- sweep(pchi, 1, df, "/")
- pchi[-(ntrm + 1), ] <- sweep(pchi[-(ntrm + 1), , drop = FALSE],
- 2, pchi[ntrm + 1, , drop = FALSE], "/")
- ## Round to avoid arbitrary P values due to numerical precision
- pchi <- round(pchi, 12)
- Fval <- round(Fval, 12)
- P <- rowSums(sweep(pchi[-(ntrm + 1), , drop = FALSE], 1,
- Fval[-(ntrm + 1)], ">="))
- P <- c((P + adj)/(step + adj), NA)
- out <- data.frame(df, chi, Fval, c(rep(step, ntrm), NA),
- P)
- inertname <- if (sim$method == "cca")
- "Chisq"
- else "Var"
- colnames(out) <- c("Df", inertname, "F", "N.Perm", "Pr(>F)")
- out <- out[out[, 1] > 0 | out[, 2] > sqrt(.Machine$double.eps),
- ]
- head <- paste("Permutation test for", sim$method, "under",
- sim$model, "model\nTerms added sequentially (first to last)\n")
- if (!is.null(sim$strata))
- head <- paste(head, "Permutations stratified within '",
- sim$strata, "'\n", sep = "")
- structure(out, heading = c(head, call), Random.seed = sim$Random.seed,
- class = c("anova.cca", "anova", "data.frame"))
-}
Deleted: pkg/vegan/man/ccanova.Rd
===================================================================
--- pkg/vegan/man/ccanova.Rd 2014-09-18 13:57:33 UTC (rev 2885)
+++ pkg/vegan/man/ccanova.Rd 2014-09-22 08:38:01 UTC (rev 2886)
@@ -1,72 +0,0 @@
-\name{ccanova}
-\alias{ccanova}
-\alias{anova.prc}
-
-\title{Permutation Test for Constrained Correspondence Analysis,
- Redundancy Analysis and Constrained Analysis of Principal Coordinates }
-\description{
- This function is deprecated.
-}
-\usage{
-ccanova(object, alpha=0.05, beta=0.01, step=100, perm.max=9999,
- by = NULL, ...)
-}
-
-\arguments{
- \item{object}{A result object from \code{\link{cca}}. }
- \item{alpha}{Targeted Type I error rate. }
- \item{beta}{Accepted Type II error rate. }
- \item{step}{Number of permutations during one step. }
- \item{perm.max}{Maximum number of permutations. }
- \item{by}{Setting \code{by = "axis"} will assess significance for each
- constrained axis, and setting \code{by = "terms"} will assess
- significance for each term (sequentially from first to last), and
- setting \code{by = "margin"} will assess the marginal effects of the
- terms (each marginal term analysed in a model with all other
- variables).}
- \item{\dots}{Parameters passed to other functions.
- \code{anova.cca} passes all arguments to
- \code{permutest.cca}. In \code{anova} with \code{by = "axis"} you
- can use argument \code{cutoff} (defaults \code{1}) which stops
- permutations after exceeding the given level. }
-}
-\details{
-
- Function \code{ccanova} is a deprecated version of \code{anova.cca}.
- The new \code{link{anova.cca}} function is completely
- rewritten. With the same random number seed and the same number of
- permutations, the results are mostly identical. The only difference
- is that marginal tests (\code{by = "margin"}) are implemented
- differently. The most important difference is that the new code is
- based on the \pkg{permute} package and uses the fixed number of
- permutations in all tests (cf. below). Both the new and old
- functions are based \code{\link{permutest.cca}}, and the function
- can pass extra arguments to \code{permutest.cca}.
-
- In \code{ccanova} the number of permutations is controlled by
- targeted \dQuote{critical} \eqn{P} value (\code{alpha}) and accepted
- Type II or rejection error (\code{beta}). If the results of
- permutations differ from the targeted \code{alpha} at risk level
- given by \code{beta}, the permutations are terminated. If the
- current estimate of \eqn{P} does not differ significantly from
- \code{alpha} of the alternative hypothesis, the permutations are
- continued with \code{step} new permutations (at the first step, the
- number of permutations is \code{step - 1}). However, with
- \code{by="terms"} a fixed number of permutations will be used, and
- this is given by argument \code{permutations}, or if this is
- missing, by \code{step}.
-
-}
-
-\note{
- The function is deprecated and replaced with \code{\link{anova.cca}}.
-}
-\references{
- Legendre, P. and Legendre, L. (2012). \emph{Numerical Ecology}. 3rd
- English ed. Elsevier.
-}
-\author{Jari Oksanen}
-
-\keyword{ multivariate }
-\keyword{ htest }
-
Modified: pkg/vegan/man/oecosimu.Rd
===================================================================
--- pkg/vegan/man/oecosimu.Rd 2014-09-18 13:57:33 UTC (rev 2885)
+++ pkg/vegan/man/oecosimu.Rd 2014-09-22 08:38:01 UTC (rev 2886)
@@ -84,7 +84,7 @@
processing. The parallel processing is done with \pkg{parallel}
package which is available only for \R 2.14.0 and later. If you
define a \code{nestfun} in Windows that needs other \R packages
- than \pkg{vegan} or \pkg{permute}, you must set up a scoket
+ than \pkg{vegan} or \pkg{permute}, you must set up a socket
cluster before the call. See \code{\link{vegandocs}}
\code{decision-vegan} for details. }
\item{x}{An \code{oecosimu} result object.}
More information about the Vegan-commits
mailing list