[Vegan-commits] r2806 - in branches/2.0: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Dec 5 12:14:49 CET 2013
Author: jarioksa
Date: 2013-12-05 12:14:49 +0100 (Thu, 05 Dec 2013)
New Revision: 2806
Modified:
branches/2.0/DESCRIPTION
branches/2.0/R/permutest.betadisper.R
branches/2.0/inst/ChangeLog
branches/2.0/man/betadisper.Rd
branches/2.0/man/permutest.betadisper.Rd
Log:
open vegan 2.0-10: adapt permutest.betadisper to permute 0.8-0 in CRAN
Modified: branches/2.0/DESCRIPTION
===================================================================
--- branches/2.0/DESCRIPTION 2013-12-03 21:05:17 UTC (rev 2805)
+++ branches/2.0/DESCRIPTION 2013-12-05 11:14:49 UTC (rev 2806)
@@ -1,12 +1,12 @@
Package: vegan
Title: Community Ecology Package
-Version: 2.0-9
-Date: September 25, 2013
+Version: 2.0-10
+Date: December 5, 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
Maintainer: Jari Oksanen <jari.oksanen at oulu.fi>
-Depends: permute, lattice, R (>= 2.14.0)
+Depends: permute (>= 0.8-0), lattice, R (>= 2.14.0)
Suggests: MASS, mgcv, cluster, scatterplot3d, rgl, tcltk
Description: Ordination methods, diversity analysis and other
functions for community and vegetation ecologists.
Modified: branches/2.0/R/permutest.betadisper.R
===================================================================
--- branches/2.0/R/permutest.betadisper.R 2013-12-03 21:05:17 UTC (rev 2805)
+++ branches/2.0/R/permutest.betadisper.R 2013-12-05 11:14:49 UTC (rev 2806)
@@ -1,5 +1,5 @@
`permutest.betadisper` <- function(x, pairwise = FALSE,
- control = permControl(nperm = 999), ...)
+ control = how(nperm = 999), ...)
{
t.statistic <- function(x, y) {
m <- length(x)
@@ -11,6 +11,7 @@
pooled <- sqrt(((m-1)*xvar + (n-1)*yvar) / (m+n-2))
(xbar - ybar) / (pooled * sqrt(1/m + 1/n))
}
+
if(!inherits(x, "betadisper"))
stop("Only for class \"betadisper\"")
## will issue error if only a single group
@@ -20,42 +21,61 @@
mod.Q <- mod$qr
p <- mod.Q$rank
resids <- qr.resid(mod.Q, x$distances)
- res <- numeric(length = control$nperm + 1)
+
+ ## extract groups
+ group <- x$group
+
+ ## get set of permutations - shuffleSet checks design
+ perms <- shuffleSet(length(group), control = control)
+
+ ## number of permutations being performed, possibly adjusted after
+ ## checking in shuffleSet
+ nperm <- nrow(perms)
+
+ ## set-up objects to hold permuted results
+ res <- numeric(length = nperm + 1)
res[1] <- summary(mod)$fstatistic[1]
+
## pairwise comparisons
if(pairwise) {
## unique pairings
combin <- combn(levels(x$group), 2)
n.pairs <- ncol(combin)
- t.stats <- matrix(0, ncol = n.pairs, nrow = control$nperm + 1)
- t.stats[1,] <- apply(combn(levels(x$group), 2), 2, function(z) {
- t.statistic(x$distances[x$group == z[1]],
- x$distances[x$group == z[2]])})
+ t.stats <- matrix(0, ncol = n.pairs, nrow = nperm + 1)
+ t.stats[1,] <- apply(combn(levels(group), 2), 2, function(z) {
+ t.statistic(x$distances[group == z[1]],
+ x$distances[group == z[2]])})
}
- for(i in seq(along = res[-1])) {
- perm <- shuffle(nobs, control = control)
- perm.resid <- resids[perm]
- f <- qr.fitted(mod.Q, perm.resid)
+
+ ## begin loop over shuffleSet perms
+ for(i in seq_len(nperm)) {
+ perm <- perms[i,] ## take current permutation from set
+ perm.resid <- resids[perm] ## permute residuals
+ f <- qr.fitted(mod.Q, perm.resid) ## create new data
mss <- sum((f - mean(f))^2)
r <- qr.resid(mod.Q, perm.resid)
rss <- sum(r^2)
rdf <- nobs - p
resvar <- rss / rdf
res[i+1] <- (mss / (p - 1)) / resvar
+
## pairwise comparisons
if(pairwise) {
for(j in seq_len(n.pairs)) {
- grp1 <- x$distance[perm][x$group == combin[1, j]]
- grp2 <- x$distance[perm][x$group == combin[2, j]]
+ grp1 <- x$distance[perm][group == combin[1, j]]
+ grp2 <- x$distance[perm][group == combin[2, j]]
t.stats[i+1, j] <- t.statistic(grp1, grp2)
}
}
}
+
+ ## compute permutation p-value
pval <- sum(res >= res[1]) / length(res)
+
if(pairwise) {
df <- apply(combin, 2, function(z) {
- length(x$distances[x$group == z[1]]) +
- length(x$distance[x$group == z[2]]) - 2})
+ length(x$distances[group == z[1]]) +
+ length(x$distance[group == z[2]]) - 2})
pairwise <- list(observed = 2 * pt(-abs(t.stats[1,]), df),
permuted = apply(t.stats, 2,
function(z) sum(abs(z) >= abs(z[1]))/length(z)))
@@ -64,12 +84,13 @@
} else {
pairwise <- NULL
}
- retval <- cbind(mod.aov[, 1:4], c(control$nperm, NA), c(pval, NA))
+
+ retval <- cbind(mod.aov[, 1:4], c(nperm, NA), c(pval, NA))
dimnames(retval) <- list(c("Groups", "Residuals"),
c("Df", "Sum Sq", "Mean Sq", "F", "N.Perm",
"Pr(>F)"))
retval <- list(tab = retval, pairwise = pairwise,
- groups = levels(x$group), control = control)
+ groups = levels(group), control = control)
class(retval) <- "permutest.betadisper"
retval
}
Modified: branches/2.0/inst/ChangeLog
===================================================================
--- branches/2.0/inst/ChangeLog 2013-12-03 21:05:17 UTC (rev 2805)
+++ branches/2.0/inst/ChangeLog 2013-12-05 11:14:49 UTC (rev 2806)
@@ -2,6 +2,11 @@
VEGAN RELEASE VERSIONS at http://cran.r-project.org/
+Version 2.0-10 (opened December 5, 2013)
+
+ * merge 2527: adapt permutest.betadisper to the CRAN release of
+ permute 0.8-0.
+
Version 2.0-9 (released September 25, 2013)
* merge 2618: a typo.
Modified: branches/2.0/man/betadisper.Rd
===================================================================
--- branches/2.0/man/betadisper.Rd 2013-12-03 21:05:17 UTC (rev 2805)
+++ branches/2.0/man/betadisper.Rd 2013-12-05 11:14:49 UTC (rev 2806)
@@ -279,7 +279,7 @@
dis[c(2, 20)] <- NA
mod2 <- betadisper(dis, groups) ## warnings
mod2
-permutest(mod2, control = permControl(nperm = 100))
+permutest(mod2, control = how(nperm = 100))
anova(mod2)
plot(mod2)
boxplot(mod2)
@@ -288,7 +288,7 @@
## Using group centroids
mod3 <- betadisper(dis, groups, type = "centroid")
mod3
-permutest(mod3, control = permControl(nperm = 100))
+permutest(mod3, control = how(nperm = 100))
anova(mod3)
plot(mod3)
boxplot(mod3)
Modified: branches/2.0/man/permutest.betadisper.Rd
===================================================================
--- branches/2.0/man/permutest.betadisper.Rd 2013-12-03 21:05:17 UTC (rev 2805)
+++ branches/2.0/man/permutest.betadisper.Rd 2013-12-05 11:14:49 UTC (rev 2806)
@@ -10,7 +10,7 @@
}
\usage{
\method{permutest}{betadisper}(x, pairwise = FALSE,
- control = permControl(nperm = 999), \dots)
+ control = how(nperm = 999), \dots)
}
%- maybe also 'usage' for other objects documented here.
\arguments{
@@ -18,8 +18,7 @@
call to \code{betadisper}.}
\item{pairwise}{logical; perform pairwise comparisons of group means?}
\item{control}{a list of control values for the permutations
- to replace the default values returned by the function
- \code{\link{permControl}}}
+ as returned by the function \code{\link[permute]{how}}}
\item{\dots}{Arguments passed to other methods.}
}
\details{
@@ -49,7 +48,7 @@
pairwise comparisons of group mean distances (dispersions or variances).}
\item{groups}{character; the levels of the grouping factor.}
\item{control}{a list, the result of a call to
- \code{\link{permControl}}.}
+ \code{\link{how}}.}
}
\references{
Anderson, M.J. (2006) Distance-based tests for homogeneity of
More information about the Vegan-commits
mailing list