[Vegan-commits] r2527 - in pkg/vegan: . R inst man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Jun 12 22:57:40 CEST 2013


Author: gsimpson
Date: 2013-06-12 22:57:39 +0200 (Wed, 12 Jun 2013)
New Revision: 2527

Modified:
   pkg/vegan/DESCRIPTION
   pkg/vegan/R/permutest.betadisper.R
   pkg/vegan/inst/ChangeLog
   pkg/vegan/man/betadisper.Rd
   pkg/vegan/man/permutest.betadisper.Rd
Log:
bump to 2.1-31, add dependency on permute >= 0.7-4, update betadisper, permutest betadisper to now final permute API

Modified: pkg/vegan/DESCRIPTION
===================================================================
--- pkg/vegan/DESCRIPTION	2013-06-12 20:22:04 UTC (rev 2526)
+++ pkg/vegan/DESCRIPTION	2013-06-12 20:57:39 UTC (rev 2527)
@@ -1,12 +1,12 @@
 Package: vegan
 Title: Community Ecology Package
-Version: 2.1-30
-Date: May 5, 2013
+Version: 2.1-31
+Date: June 12, 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, R (>= 2.12.0)
+Depends: permute (>= 0.7-4), R (>= 2.12.0)
 Imports: lattice
 Suggests: MASS, mgcv, lattice, cluster, parallel, scatterplot3d, rgl, tcltk
 Description: Ordination methods, diversity analysis and other

Modified: pkg/vegan/R/permutest.betadisper.R
===================================================================
--- pkg/vegan/R/permutest.betadisper.R	2013-06-12 20:22:04 UTC (rev 2526)
+++ pkg/vegan/R/permutest.betadisper.R	2013-06-12 20:57:39 UTC (rev 2527)
@@ -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: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog	2013-06-12 20:22:04 UTC (rev 2526)
+++ pkg/vegan/inst/ChangeLog	2013-06-12 20:57:39 UTC (rev 2527)
@@ -2,6 +2,14 @@
 
 VEGAN DEVEL VERSIONS at http://r-forge.r-project.org/
 
+Version 2.1-31
+
+	* Dependencies: Vegan now depends on a version equal to 0.7-4 or
+	later.
+
+	* betadisper, permutest.betadisper: Modified to use the new
+	permute package API (from version 0.7-3 onwards).
+
 Version 2.1-30 (opened May 5, 2013)
 
 	* bioenv: can now use Mahalanobis, Manhattan and Gower distances

Modified: pkg/vegan/man/betadisper.Rd
===================================================================
--- pkg/vegan/man/betadisper.Rd	2013-06-12 20:22:04 UTC (rev 2526)
+++ pkg/vegan/man/betadisper.Rd	2013-06-12 20:57:39 UTC (rev 2527)
@@ -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: pkg/vegan/man/permutest.betadisper.Rd
===================================================================
--- pkg/vegan/man/permutest.betadisper.Rd	2013-06-12 20:22:04 UTC (rev 2526)
+++ pkg/vegan/man/permutest.betadisper.Rd	2013-06-12 20:57:39 UTC (rev 2527)
@@ -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