[Vegan-commits] r967 - in pkg/vegan: R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Aug 31 20:25:17 CEST 2009
Author: psolymos
Date: 2009-08-31 20:25:16 +0200 (Mon, 31 Aug 2009)
New Revision: 967
Modified:
pkg/vegan/R/oecosimu.R
pkg/vegan/R/print.oecosimu.R
pkg/vegan/inst/ChangeLog
pkg/vegan/man/oecosimu.Rd
Log:
getting rid of permat*
Modified: pkg/vegan/R/oecosimu.R
===================================================================
--- pkg/vegan/R/oecosimu.R 2009-08-31 15:36:49 UTC (rev 966)
+++ pkg/vegan/R/oecosimu.R 2009-08-31 18:25:16 UTC (rev 967)
@@ -1,30 +1,25 @@
`oecosimu` <-
function(comm, nestfun, method, nsimul=99,
burnin=0, thin=1, statistic = "statistic",
- control, ...)
+ ...)
{
nestfun <- match.fun(nestfun)
- method <- match.arg(method, c("r00", "r0", "r1", "r2", "c0",
+ if (!is.function(method)) {
+ method <- match.arg(method, c("r00", "r0", "r1", "r2", "c0",
"swap", "tswap", "backtrack",
- "quasiswap", "permat")) # "permat" method added
- ## eveluate according to method
- if (method == "permat") {
- quant <- TRUE
- if (missing(control))
- control <- permat.control()
- pfull <- control$ptype == "full"
-# if (control$method %in% c("swap", "tswap", "abuswap")) {
-# if (thin != control$thin)
-# warning("'thin' and 'control$thin' not equal")
-# if (burnin != control$burnin)
-# warning("'burnin' and 'control$burnin' not equal")
-# }
- } else quant <- FALSE
+ "r2dtable")) # "permat" method added
+ if (method == "r2dtable") {
+ nr <- rowSums(comm)
+ nc <- rowSums(comm)
+ permfun <- function(z) r2dtable(1, nr, nc)[[1]]
+ }
+ } else {
+ permfun <- match.fun(method)
+ method <- "custom"
+ }
+ quant <- if (method %in% c("r2dtable", "custom"))
+ TRUE else FALSE
- ## conditional on quant value
- if (!quant)
- comm <- ifelse(comm > 0, 1, 0)
-
ind <- nestfun(comm, ...)
if (is.list(ind))
indstat <- ind[[statistic]]
@@ -33,8 +28,9 @@
n <- length(indstat)
simind <- matrix(0, nrow=n, ncol=nsimul)
- ## quant = FALSE
+ ## permutation for binary data
if (!quant) {
+ comm <- ifelse(comm > 0, 1, 0)
if (method %in% c("swap", "tswap")){
checkbrd <- 1
if (method == "tswap") {
@@ -68,47 +64,33 @@
simind[,i] <- tmp
}
}
- ## this is new addition for quantitative null model simulations
- ## quant = TRUE
+ ## permutation for count data
} else {
- ## permatfull
- if (pfull) {
- for (i in 1:nsimul) {
- x <- permatfull(comm, fixedmar=control$fixedmar,
- shuffle=control$shuffle,
- strata=control$strata,
- mtype=control$mtype, times=1)
- tmp <- nestfun(x$perm[[1]])
- if (is.list(tmp)) {
- simind[, i] <- tmp[[statistic]]
- } else simind[, i] <- tmp
- }
- attr(simind, "thin") <- NULL
- attr(simind, "burnin") <- NULL
- ## permatswap
- } else {
- if (control$method %in% c("swap", "tswap", "abuswap") && burnin > 0) {
- m <- permatswap(comm, method=control$method,
- fixedmar=control$fixedmar,
- shuffle=control$shuffle,
- strata=control$strata,
- mtype=control$mtype, times=1,
- burnin=burnin, thin=0)$perm[[1]]
+ if (!all(dim(comm) == dim(permfun(comm))))
+ stop("permutation function is not compatible with community matrix")
+ ## sequential algorithms
+ if (burnin > 0 || thin > 1) {
+ if (burnin > 0) {
+ m <- permfun(comm, burnin=burnin, thin=1)
} else m <- comm
for (i in 1:nsimul) {
- x <- permatswap(m, method=control$method,
- fixedmar=control$fixedmar,
- shuffle=control$shuffle,
- strata=control$strata,
- mtype=control$mtype, times=1,
- burnin=0, thin=thin)
- tmp <- nestfun(x$perm[[1]], ...)
+ tmp <- nestfun(permfun(m, burnin=0, thin=thin), ...)
if (is.list(tmp))
simind[, i] <- tmp[[statistic]]
else simind[, i] <- tmp
}
attr(simind, "thin") <- thin
attr(simind, "burnin") <- burnin
+ ## not sequential algorithms
+ } else {
+ for (i in 1:nsimul) {
+ tmp <- nestfun(permfun(comm), ...)
+ if (is.list(tmp)) {
+ simind[, i] <- tmp[[statistic]]
+ } else simind[, i] <- tmp
+ }
+ attr(simind, "thin") <- NULL
+ attr(simind, "burnin") <- NULL
}
}
## end of addition
@@ -121,16 +103,16 @@
## try e.g. oecosimu(dune, sum, "permat")
if (any(is.na(z)))
p[is.na(z)] <- NA
- ## collapse method with control$method
- if (method == "permat" && control$ptype == "swap")
- method <- paste("permat", control$method, sep=".")
if (is.null(names(indstat)))
names(indstat) <- statistic
if (!is.list(ind))
ind <- list(statistic = ind)
+ if (method == "custom")
+ attr(method, "permfun") <- permfun
ind$oecosimu <- list(z = z, pval = p, simulated=simind, method=method,
statistic = indstat)
class(ind) <- c("oecosimu", class(ind))
ind
}
+
Modified: pkg/vegan/R/print.oecosimu.R
===================================================================
--- pkg/vegan/R/print.oecosimu.R 2009-08-31 15:36:49 UTC (rev 966)
+++ pkg/vegan/R/print.oecosimu.R 2009-08-31 18:25:16 UTC (rev 967)
@@ -4,16 +4,10 @@
cat("oecosimu with", ncol(x$oecosimu$simulated), "simulations\n")
cat("simulation method", x$oecosimu$method)
## dim attribute is always there, but print all others
-
- ## addition starts here to evaluate type of nullmodel
- isThinned <- !is.null(attr(x$oecosimu$simulated, "thin"))
- if (isThinned)
- ## end of addition
-
- if (length(att <- attributes(x$oecosimu$simulated)) > 1) {
- att$dim <- NULL
- cat(" with", paste(names(att), att, collapse=", "))
- }
+ if (length(att <- attributes(x$oecosimu$simulated)) > 1) {
+ att$dim <- NULL
+ cat(" with", paste(names(att), att, collapse=", "))
+ }
cat("\n\n")
cl <- class(x)
if (length(cl) > 1 && cl[2] != "list") {
Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog 2009-08-31 15:36:49 UTC (rev 966)
+++ pkg/vegan/inst/ChangeLog 2009-08-31 18:25:16 UTC (rev 967)
@@ -4,6 +4,10 @@
Version 1.16-26 (opened August 31,2009)
+ * oecosimu: does not depend on permatfull/permatswap, but method
+ can be a function. The r2dtable method implemented also
+ to be used with adipart and related functions.
+
* bioenv: uses standard R function combn() and removes
ripley.subs() and ripley.subsets() from vegan. The result should
be unchanged.
Modified: pkg/vegan/man/oecosimu.Rd
===================================================================
--- pkg/vegan/man/oecosimu.Rd 2009-08-31 15:36:49 UTC (rev 966)
+++ pkg/vegan/man/oecosimu.Rd 2009-08-31 18:25:16 UTC (rev 967)
@@ -20,7 +20,7 @@
\usage{
oecosimu(comm, nestfun, method, nsimul = 99, burnin = 0, thin = 1,
- statistic = "statistic", control, ...)
+ statistic = "statistic", ...)
commsimulator(x, method, thin=1)
\method{as.ts}{oecosimu}(x, ...)
\method{as.mcmc}{oecosimu}(x)
@@ -47,9 +47,6 @@
\code{"swap"} and \code{"tswap"}.}
\item{statistic}{The name of the statistic returned by
\code{nestedfun}}
- \item{control}{A list of arguments passed to quantitative
- permutation algorithms. If missing, the function
- \code{permat.control} is used.}
\item{data}{Ignored argument of the generic function.}
\item{xlab}{Label of the x-axis.}
\item{\dots}{Other arguments to functions.}
@@ -60,7 +57,7 @@
Function \code{oecosimu} is a wrapper that evaluates a nestedness
statistic using function given by \code{nestfun}, and then simulates a
series of null models using \code{commsimulator} or
- \code{permatfull} / \code{permatswap} (depending on method), and evaluates the
+ other functions (depending on method argument), and evaluates the
statistic on these null models. The \pkg{vegan} packages contains some
nestedness functions that are described separately
(\code{\link{nestedchecker}}, \code{\link{nesteddisc}},
@@ -164,15 +161,17 @@
use the longer form \code{densityplot.oecosimu} when you first time
call the function.
- As a result of method \code{permat} in \code{oecosimu}, quantitative
- community null models are used to evaluate the statistic. Through
- the \code{control} argument, further options can be set via the
- function \code{\link{permat.control}}. A full description of these
- settings can be found on the help pages of the functions
- \code{\link{permatfull}} and \code{\link{permatswap}}. Note, that
- \code{burnin} and \code{thin} arguments given in the \code{oecosimu}
- function call overwrite the respective ones specified by
- \code{permat.control}.
+ As a result of \code{method = "r2dtable"} in \code{oecosimu}, quantitative
+ community null models are used to evaluate the statistic. This setting uses
+ the \code{\link{r2dtable}} function to generate random matrices with fixed
+ row and column totals (hypergeometric distribution). This null model is
+ used in diversity partitioning function (see \code{\link{adipart}}).
+
+ The \code{method} argument can be a function with first argument taking the
+ community matrix, and optionally with \code{burnin} and \code{thin} argument.
+ The function must return a matrix-like object with same dimensions.
+ But be careful, blindly applying permuted matrices for null model testing
+ can be dangerous.
}
\value{
@@ -256,14 +255,16 @@
## mean Bray-Curtis dissimilarities
data(dune)
meandist <- function(x) mean(vegdist(x, "bray"))
-out.mbc <- oecosimu(dune, meandist, "permat")
-out.mbc
-## Use the quantitative quasiswap algorithm
-## to compare Shannon diversities by samples
-contr <- permat.control(ptype="swap", method="quasiswap")
-out.div <- oecosimu(dune, diversity, "permat", control=contr)
-out.div
+mbc1 <- oecosimu(dune, meandist, "r2dtable")
+mbc1
+## Define a custom function that shuffles
+## cells in each rows
+f <- function(x) {
+ apply(x, 2, function(z) sample(z, length(z)))
}
+mbc2 <- oecosimu(as.matrix(dune), meandist, f)
+mbc2
+}
\keyword{ multivariate }
\keyword{ datagen }
More information about the Vegan-commits
mailing list