[Vegan-commits] r2799 - in pkg/vegan: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Dec 3 18:03:29 CET 2013
Author: jarioksa
Date: 2013-12-03 18:03:28 +0100 (Tue, 03 Dec 2013)
New Revision: 2799
Added:
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
Removed:
pkg/vegan/R/anova.cca.R
pkg/vegan/R/anova.ccabyaxis.R
pkg/vegan/R/anova.ccabymargin.R
pkg/vegan/R/anova.ccabyterm.R
pkg/vegan/man/anova.cca.Rd
Modified:
pkg/vegan/DESCRIPTION
pkg/vegan/inst/ChangeLog
Log:
first stage of replacing old anova.cca: rename old functions to ccanova*
Modified: pkg/vegan/DESCRIPTION
===================================================================
--- pkg/vegan/DESCRIPTION 2013-12-03 16:37:33 UTC (rev 2798)
+++ pkg/vegan/DESCRIPTION 2013-12-03 17:03:28 UTC (rev 2799)
@@ -1,7 +1,7 @@
Package: vegan
Title: Community Ecology Package
-Version: 2.1-39
-Date: November 10, 2013
+Version: 2.1-40
+Date: December 3, 2013
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
Deleted: pkg/vegan/R/anova.cca.R
===================================================================
--- pkg/vegan/R/anova.cca.R 2013-12-03 16:37:33 UTC (rev 2798)
+++ pkg/vegan/R/anova.cca.R 2013-12-03 17:03:28 UTC (rev 2799)
@@ -1,62 +0,0 @@
-`anova.cca` <-
- 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 <- anova.ccabyaxis(object, alpha = alpha, beta = beta,
- step = step, perm.max = perm.max, by = NULL,
- ...)
- else if (by == "margin") {
- sol <- anova.ccabymargin(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 <- anova.ccabyterm(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/anova.ccabyaxis.R
===================================================================
--- pkg/vegan/R/anova.ccabyaxis.R 2013-12-03 16:37:33 UTC (rev 2798)
+++ pkg/vegan/R/anova.ccabyaxis.R 2013-12-03 17:03:28 UTC (rev 2799)
@@ -1,89 +0,0 @@
-`anova.ccabyaxis` <-
- 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 <- anova(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(anova(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/anova.ccabymargin.R
===================================================================
--- pkg/vegan/R/anova.ccabymargin.R 2013-12-03 16:37:33 UTC (rev 2798)
+++ pkg/vegan/R/anova.ccabymargin.R 2013-12-03 17:03:28 UTC (rev 2799)
@@ -1,52 +0,0 @@
-`anova.ccabymargin` <-
- function(object, step=100, scope, ...)
-{
- if(inherits(object, "prc"))
- stop("anova(..., 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 <- anova(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/anova.ccabyterm.R
===================================================================
--- pkg/vegan/R/anova.ccabyterm.R 2013-12-03 16:37:33 UTC (rev 2798)
+++ pkg/vegan/R/anova.ccabyterm.R 2013-12-03 17:03:28 UTC (rev 2799)
@@ -1,78 +0,0 @@
-`anova.ccabyterm` <-
- 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"))
-}
Copied: pkg/vegan/R/ccanova.R (from rev 2796, pkg/vegan/R/anova.cca.R)
===================================================================
--- pkg/vegan/R/ccanova.R (rev 0)
+++ pkg/vegan/R/ccanova.R 2013-12-03 17:03:28 UTC (rev 2799)
@@ -0,0 +1,62 @@
+`anova.cca` <-
+ 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"))
+}
Copied: pkg/vegan/R/ccanova.byaxis.R (from rev 2796, pkg/vegan/R/anova.ccabyaxis.R)
===================================================================
--- pkg/vegan/R/ccanova.byaxis.R (rev 0)
+++ pkg/vegan/R/ccanova.byaxis.R 2013-12-03 17:03:28 UTC (rev 2799)
@@ -0,0 +1,89 @@
+`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
+}
Copied: pkg/vegan/R/ccanova.bymargin.R (from rev 2796, pkg/vegan/R/anova.ccabymargin.R)
===================================================================
--- pkg/vegan/R/ccanova.bymargin.R (rev 0)
+++ pkg/vegan/R/ccanova.bymargin.R 2013-12-03 17:03:28 UTC (rev 2799)
@@ -0,0 +1,52 @@
+`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
+}
Copied: pkg/vegan/R/ccanova.byterm.R (from rev 2796, pkg/vegan/R/anova.ccabyterm.R)
===================================================================
--- pkg/vegan/R/ccanova.byterm.R (rev 0)
+++ pkg/vegan/R/ccanova.byterm.R 2013-12-03 17:03:28 UTC (rev 2799)
@@ -0,0 +1,78 @@
+`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"))
+}
Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog 2013-12-03 16:37:33 UTC (rev 2798)
+++ pkg/vegan/inst/ChangeLog 2013-12-03 17:03:28 UTC (rev 2799)
@@ -2,7 +2,13 @@
VEGAN DEVEL VERSIONS at http://r-forge.r-project.org/
-Version 2.1-39 (opened November 10, 2013)
+Version 2.1-40 (opened December 3, 2013)
+
+ * anova.cca: start deprecation of old anova.cca and rename it to
+ ccanova. Vegan should fail all tests while deprecation is
+ incomplete and new code is not yet in use.
+
+Version 2.1-39 (closed December 3, 2013)
* anova.cca: started to rewrite the anova.cca family of functions
for permute package. At the first stage, a temporary development
Deleted: pkg/vegan/man/anova.cca.Rd
===================================================================
--- pkg/vegan/man/anova.cca.Rd 2013-12-03 16:37:33 UTC (rev 2798)
+++ pkg/vegan/man/anova.cca.Rd 2013-12-03 17:03:28 UTC (rev 2799)
@@ -1,80 +0,0 @@
-\name{anova.cca}
-\alias{anova.cca}
-\alias{anova.ccanull}
-\alias{anova.ccabyaxis}
-\alias{anova.ccabyterm}
-\alias{anova.ccabymargin}
-\alias{anova.prc}
-
-\title{Permutation Test for Constrained Correspondence Analysis,
- Redundancy Analysis and Constrained Analysis of Principal Coordinates }
-\description{
- This function is deprecated.
-}
-\usage{
-\method{anova}{cca}(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{
-
- This function contains a deprecated version of \code{anova.cca}.
- The new 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{anova.cca} 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.
-
- Legendre, P., Oksanen, J. and ter Braak, C.J.F. (2011). Testing the
- significance of canonical axes in redundancy analysis.
- \emph{Methods in Ecology and Evolution} 2, 269--277.
-}
-\author{Jari Oksanen}
-
-\keyword{ multivariate }
-\keyword{ htest }
-
Added: pkg/vegan/man/ccanova.Rd
===================================================================
--- pkg/vegan/man/ccanova.Rd (rev 0)
+++ pkg/vegan/man/ccanova.Rd 2013-12-03 17:03:28 UTC (rev 2799)
@@ -0,0 +1,72 @@
+\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 }
+
More information about the Vegan-commits
mailing list