[Vegan-commits] r284 - in pkg: R inst

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Mar 25 15:23:28 CET 2008


Author: gsimpson
Date: 2008-03-25 15:23:28 +0100 (Tue, 25 Mar 2008)
New Revision: 284

Modified:
   pkg/R/allPerms.R
   pkg/inst/ChangeLog
Log:
allPerms now allows different numbers of observations per strata for "series" and "free" designs and now handles "series" designs with 2 observations per series (c.f. r283)

Modified: pkg/R/allPerms.R
===================================================================
--- pkg/R/allPerms.R	2008-03-25 14:21:14 UTC (rev 283)
+++ pkg/R/allPerms.R	2008-03-25 14:23:28 UTC (rev 284)
@@ -20,7 +20,8 @@
             X[i,] <- seq(i, length = n)%%n + 1
 	}
         ## if mirroring, rev the cols of X[v,]
-        if(control$mirror)
+        ## but only if n > 2
+        if(control$mirror && (nperms > 2))
             X[(n+1):(2*n),] <- X[v, rev(v)]
 	X
     }
@@ -109,41 +110,74 @@
                                       mirror = control$mirror,
                                       nrow = control$nrow,
                                       ncol = control$ncol)
-            nperm <- numPerms(v, control)
+            nperms <- numPerms(v, control)
             ord <- switch(control$type,
                           free = all.free(pg),
                           series = all.series(pg, control = control.wi),
                           grid = all.grid(pg, control = control.wi))
             perm.wi <- nrow(ord)
             sp <- split(v, control$strata)
-            res <- matrix(nrow = nperm, ncol = n)
+            res <- matrix(nrow = nperms, ncol = n)
             for(i in seq_len(perm.wi))
                 res[i,] <- sapply(sp, function(x) x[ord[i,]])
         } else {
             ## different permutations within blocks
-            ng <- length(levels(control$strata))
-            pg <- length(control$strata) / ng
-            control.wi <- permControl(type = control$type,
-                                      mirror = control$mirror,
-                                      nrow = control$nrow,
-                                      ncol = control$ncol)
-            ord <- switch(control$type,
-                          free = all.free(pg),
-                          series = all.series(pg, control = control.wi),
-                          grid = all.grid(pg, control = control.wi)
-                          )
-            perm.wi <- nrow(ord)
-            add <- seq(from = 0, by = pg, length.out = ng)
-            res <- vector(mode = "list", length = ng)
-            a <- 1
-            b <- nperms / perm.wi
-            for(i in seq_len(ng)) {
-                res[[i]] <- matrix(rep(bar(ord+add[i], a), each = b),
-                                   ncol = pg)
-                a <- a*perm.wi
-                b <- b/perm.wi
+            tab <- table(control$strata)
+            ng <- length(tab)
+            pg <- unique(tab)
+            if(length(pg) > 1) {
+                ## different number of observations per level of strata
+                if(control$type == "grid")
+                    ## FIXME: this should not be needed once all checks are
+                    ## in place in permCheck()
+                    stop("Unbalanced grid designs are not supported")
+                control.wi <- permControl(type = control$type,
+                                          mirror = control$mirror)
+                sp <- split(v, control$strata)
+                res <- vector(mode = "list", length = ng)
+                add <- c(0, cumsum(tab)[1:(ng-1)])
+                for(j in seq(along = tab)) {
+                    ord <- switch(control.wi$type,
+                                  free = all.free(tab[j]),
+                                  series = all.series(tab[j],
+                                  control=control.wi))
+                    perm.wi <- nrow(ord)
+                    if(j == 1) {
+                        a <- 1
+                        b <- nperms / perm.wi
+                    } else {
+                        b <- b/perm.wi
+                        a <- nperms / (b*perm.wi)
+                    }
+                    res[[j]] <- matrix(rep(bar(ord+add[j], a),
+                                           each = b),
+                                       ncol = tab[j])
+                }
+                res <- do.call(cbind, res)
+            } else {
+                ## same number of observations per level of strata
+                control.wi <- permControl(type = control$type,
+                                          mirror = control$mirror,
+                                          nrow = control$nrow,
+                                          ncol = control$ncol)
+                ord <- switch(control$type,
+                              free = all.free(pg),
+                              series = all.series(pg, control = control.wi),
+                              grid = all.grid(pg, control = control.wi)
+                              )
+                perm.wi <- nrow(ord)
+                add <- seq(from = 0, by = pg, length.out = ng)
+                res <- vector(mode = "list", length = ng)
+                a <- 1
+                b <- nperms / perm.wi
+                for(i in seq_len(ng)) {
+                    res[[i]] <- matrix(rep(bar(ord+add[i], a), each = b),
+                                       ncol = pg)
+                    a <- a*perm.wi
+                    b <- b/perm.wi
+                }
+                res <- do.call(cbind, res)
             }
-            res <- do.call(cbind, res)
         }
     } else {
         ## no blocks

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2008-03-25 14:21:14 UTC (rev 283)
+++ pkg/inst/ChangeLog	2008-03-25 14:23:28 UTC (rev 284)
@@ -14,6 +14,17 @@
 	metaMDSdist, but I try this first. For compatibility reasons, the
 	previous behaviour can be re-established using argument old.wa =
 	TRUE.
+
+	* allPerms: Now allows unbalanced designs for "series" or "free"
+	permutations within levels of strata only (i.e. allows different
+	number of observations per level of strata). Unbalanced "grid" 
+	designs are not supported (and are unlikely to be so in the near
+	future). permuted.index2 has allowed these cases from the
+	beginning.
+
+	* allPerms, numPerms: Corrected for situations where type = "series",
+	mirror = TRUE with only 2 observations. In this case, mirroring
+	does not double the number of permutations.
 	
 Version 1.12-5 (closed Mar 24, 2008)
 



More information about the Vegan-commits mailing list