[Vegan-commits] r968 - in pkg/vegan: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Aug 31 21:11:31 CEST 2009
Author: psolymos
Date: 2009-08-31 21:11:30 +0200 (Mon, 31 Aug 2009)
New Revision: 968
Modified:
pkg/vegan/R/adipart.R
pkg/vegan/R/hiersimu.R
pkg/vegan/R/multipart.R
pkg/vegan/R/oecosimu.R
pkg/vegan/R/print.oecosimu.R
pkg/vegan/man/adipart.Rd
Log:
bugfix and adapting adipart et al to new oecosimu
Modified: pkg/vegan/R/adipart.R
===================================================================
--- pkg/vegan/R/adipart.R 2009-08-31 18:25:16 UTC (rev 967)
+++ pkg/vegan/R/adipart.R 2009-08-31 19:11:30 UTC (rev 968)
@@ -1,6 +1,6 @@
adipart <-
function(formula, data, index=c("richness", "shannon", "simpson"),
- weights=c("unif", "prop"), relative = FALSE, nsimul=99, control, ...)
+ weights=c("unif", "prop"), relative = FALSE, nsimul=99, ...)
{
## evaluate formula
lhs <- formula[[2]]
@@ -49,16 +49,24 @@
ftmp[[i]] <- as.formula(paste("~", tlab[i], "- 1"))
}
+ ## is there a method/burnin/thin in ... ?
+ method <- if (is.null(list(...)$method))
+ "r2dtable" else list(...)$method
+ burnin <- if (is.null(list(...)$burnin))
+ 0 else list(...)$burnin
+ thin <- if (is.null(list(...)$thin))
+ 1 else list(...)$thin
+ base <- if (is.null(list(...)$base))
+ exp(1) else list(...)$base
+
## evaluate other arguments
index <- match.arg(index)
weights <- match.arg(weights)
- if (missing(control))
- control <- permat.control()
switch(index,
"richness" = {
divfun <- function(x) apply(x > 0, 1, sum)},
"shannon" = {
- divfun <- function(x) diversity(x, index = "shannon", MARGIN = 1, ...)},
+ divfun <- function(x) diversity(x, index = "shannon", MARGIN = 1, base=base)},
"simpson" = {
divfun <- function(x) diversity(x, index = "simpson", MARGIN = 1)})
sumMatr <- sum(lhs)
@@ -82,8 +90,8 @@
c(a, b)
}
if (nsimul > 0) {
- sim <- oecosimu(lhs, wdivfun, method = "permat", nsimul=nsimul,
- burnin=control$burnin, thin=control$thin, control=control)
+ sim <- oecosimu(lhs, wdivfun, method = method, nsimul=nsimul,
+ burnin=burnin, thin=thin)
} else {
sim <- wdivfun(lhs)
tmp <- rep(NA, length(sim))
Modified: pkg/vegan/R/hiersimu.R
===================================================================
--- pkg/vegan/R/hiersimu.R 2009-08-31 18:25:16 UTC (rev 967)
+++ pkg/vegan/R/hiersimu.R 2009-08-31 19:11:30 UTC (rev 968)
@@ -1,6 +1,6 @@
hiersimu <-
function(formula, data, FUN, location = c("mean", "median"),
-relative = FALSE, drop.highest = FALSE, nsimul=99, control, ...)
+relative = FALSE, drop.highest = FALSE, nsimul=99, ...)
{
## evaluate formula
lhs <- formula[[2]]
@@ -49,9 +49,15 @@
ftmp[[i]] <- as.formula(paste("~", tlab[i], "- 1"))
}
+ ## is there a method/burnin/thin in ... ?
+ method <- if (is.null(list(...)$method))
+ "r2dtable" else list(...)$method
+ burnin <- if (is.null(list(...)$burnin))
+ 0 else list(...)$burnin
+ thin <- if (is.null(list(...)$thin))
+ 1 else list(...)$thin
+
## evaluate other arguments
- if (missing(control))
- control <- permat.control()
if (!is.function(FUN))
stop("'FUN' must be a function")
location <- match.arg(location)
@@ -67,15 +73,15 @@
} else {
tmp <- lapply(1:nlevs, function(i) t(model.matrix(ftmp[[i]], rhs)) %*% x)
}
- a <- sapply(1:nlevs, function(i) aggrFUN(FUN(tmp[[i]], ...)))
+ a <- sapply(1:nlevs, function(i) aggrFUN(FUN(tmp[[i]]))) # dots removed from FUN
if (relative)
a <- a / a[length(a)]
a
}
## processing oecosimu results
- sim <- oecosimu(lhs, evalFUN, method = "permat", nsimul=nsimul,
- burnin=control$burnin, thin=control$thin, control=control)
+ sim <- oecosimu(lhs, evalFUN, method = method, nsimul=nsimul,
+ burnin=burnin, thin=thin)
# nam <- paste("level", 1:nlevs, sep=".")
# names(sim$statistic) <- attr(sim$oecosimu$statistic, "names") <- nam
names(sim$statistic) <- attr(sim$oecosimu$statistic, "names") <- tlab[1:nlevs]
Modified: pkg/vegan/R/multipart.R
===================================================================
--- pkg/vegan/R/multipart.R 2009-08-31 18:25:16 UTC (rev 967)
+++ pkg/vegan/R/multipart.R 2009-08-31 19:11:30 UTC (rev 968)
@@ -1,6 +1,6 @@
multipart <-
function(formula, data, index=c("renyi", "tsallis"), scales = 1,
- global = FALSE, relative = FALSE, nsimul=99, control, ...)
+ global = FALSE, relative = FALSE, nsimul=99, ...)
{
if (length(scales) > 1)
stop("length of 'scales' must be 1")
@@ -46,17 +46,23 @@
## aggregate response matrix
fullgamma <-if (nlevels(rhs[,nlevs]) == 1)
TRUE else FALSE
- if (!fullgamma && !global)
- warning("gamma diversity value might be meaningless")
+# if (!fullgamma && !global)
+# warning("gamma diversity value might be meaningless")
ftmp <- vector("list", nlevs)
for (i in 1:nlevs) {
ftmp[[i]] <- as.formula(paste("~", tlab[i], "- 1"))
}
+ ## is there a method/burnin/thin in ... ?
+ method <- if (is.null(list(...)$method))
+ "r2dtable" else list(...)$method
+ burnin <- if (is.null(list(...)$burnin))
+ 0 else list(...)$burnin
+ thin <- if (is.null(list(...)$thin))
+ 1 else list(...)$thin
+
## evaluate other arguments
index <- match.arg(index)
- if (missing(control))
- control <- permat.control()
divfun <- switch(index,
"renyi" = function(x) renyi(x, scales=scales, hill = TRUE),
"tsallis" = function(x) tsallis(x, scales=scales, hill = TRUE))
@@ -110,8 +116,8 @@
}
}
if (nsimul > 0) {
- sim <- oecosimu(lhs, wdivfun, method = "permat", nsimul=nsimul,
- burnin=control$burnin, thin=control$thin, control=control)
+ sim <- oecosimu(lhs, wdivfun, method = method, nsimul=nsimul,
+ burnin=burnin, thin=thin)
} else {
sim <- wdivfun(lhs)
tmp <- rep(NA, length(sim))
Modified: pkg/vegan/R/oecosimu.R
===================================================================
--- pkg/vegan/R/oecosimu.R 2009-08-31 18:25:16 UTC (rev 967)
+++ pkg/vegan/R/oecosimu.R 2009-08-31 19:11:30 UTC (rev 968)
@@ -10,7 +10,7 @@
"r2dtable")) # "permat" method added
if (method == "r2dtable") {
nr <- rowSums(comm)
- nc <- rowSums(comm)
+ nc <- colSums(comm)
permfun <- function(z) r2dtable(1, nr, nc)[[1]]
}
} else {
Modified: pkg/vegan/R/print.oecosimu.R
===================================================================
--- pkg/vegan/R/print.oecosimu.R 2009-08-31 18:25:16 UTC (rev 967)
+++ pkg/vegan/R/print.oecosimu.R 2009-08-31 19:11:30 UTC (rev 968)
@@ -1,6 +1,7 @@
`print.oecosimu` <-
function(x, ...)
{
+ attr(x$oecosimu$method, "permfun") <- NULL
cat("oecosimu with", ncol(x$oecosimu$simulated), "simulations\n")
cat("simulation method", x$oecosimu$method)
## dim attribute is always there, but print all others
Modified: pkg/vegan/man/adipart.Rd
===================================================================
--- pkg/vegan/man/adipart.Rd 2009-08-31 18:25:16 UTC (rev 967)
+++ pkg/vegan/man/adipart.Rd 2009-08-31 19:11:30 UTC (rev 968)
@@ -16,11 +16,11 @@
}
\usage{
adipart(formula, data, index=c("richness", "shannon", "simpson"),
- weights=c("unif", "prop"), relative = FALSE, nsimul=99, control, ...)
+ weights=c("unif", "prop"), relative = FALSE, nsimul=99, ...)
multipart(formula, data, index=c("renyi", "tsallis"), scales = 1,
- global = FALSE, relative = FALSE, nsimul=99, control, ...)
+ global = FALSE, relative = FALSE, nsimul=99, ...)
hiersimu(formula, data, FUN, location = c("mean", "median"),
- relative = FALSE, drop.highest = FALSE, nsimul=99, control, ...)
+ relative = FALSE, drop.highest = FALSE, nsimul=99, ...)
\method{print}{adipart}(x, ...)
\method{print}{multipart}(x, ...)
\method{print}{hiersimu}(x, ...)
@@ -47,9 +47,8 @@
\item{nsimul}{Number of permutation to use if \code{matr} is not of class 'permat'.
If \code{nsimul = 0}, only the \code{FUN} argument is evaluated. It is thus possible
to reuse the statistic values without using a null model.}
- \item{control}{A list of arguments passed to quantitative permutation
- algorithms. If missing, the function 'permat.control' is used.}
- \item{FUN}{A function to be used by \code{hiersimu}.}
+ \item{FUN}{A function to be used by \code{hiersimu}. This must be fully specified,
+ because currently other arguments cannot be passed to this function via \code{\dots}.}
\item{location}{Character, identifies which function (mean or median) is used to
calculate location of the samples.}
\item{drop.highest}{Logical, to drop the highest level or not. When \code{FUN}
@@ -57,7 +56,8 @@
or not selected at all.}
\item{x}{An object to print.}
\item{\dots}{Other arguments passed to functions, e.g. base of logarithm for
- Shannon diversity (see \code{\link{diversity}}).}
+ Shannon diversity, or \code{method}, \code{thin} or \code{burnin} arguments for
+ \code{\link{oecosimu}}.}
}
\details{
Additive diversity partitioning means that mean alpha and beta diversity adds up to gamma
@@ -88,7 +88,7 @@
Multiplicative diversity partitioning is based on Whittaker's (1972) ideas, that has
recently been generalised to one parametric diversity families (i.e. \enc{R\'enyi}{Renyi}
-and Tsallis) by Jost (2006, 2007). Jost recomments to use the numbers equivalents
+and Tsallis) by Jost (2006, 2007). Jost recommends to use the numbers equivalents
(Hill numbers), instead of pure diversities, and proofs, that this satisfies the
multiplicative partitioning requirements.
@@ -114,10 +114,8 @@
given as \eqn{\beta_{max,ij} = n_{j}} (the number of lower level units in a given cluster \eqn{j}).
The expected diversity components are calculated \code{nsimul} times by individual based
-randomisation of the community data matrix. This is done by the \code{\link{permatfull}}
-and \code{\link{permatswap}} functions, and properties of the null model can be set by
-the \code{control} argument (see \code{\link{permat.control}}). The null matrics then
-evaluated via the function \code{\link{oecosimu}}.
+randomisation of the community data matrix. This is done by the \code{"r2dtable"} method
+in \code{\link{oecosimu}} by default.
\code{hiersimu} works almost the same as \code{adipart}, but without comparing the actual
statistic values returned by \code{FUN} to the highest possible value (cf. gamma diversity).
More information about the Vegan-commits
mailing list