[Vegan-commits] r2655 - in pkg/permute: R inst

[noreply at r-forge.r-project.org]

Author: gsimpson
Date: 2013-11-05 23:50:08 +0100 (Tue, 05 Nov 2013)
New Revision: 2655

Modified:
   pkg/permute/R/allPerms.R
   pkg/permute/inst/ChangeLog
Log:
fixes several bugs handling the blocking structures (correctly subsets plot strata now) and deals with no plot strata in design

Modified: pkg/permute/R/allPerms.R
===================================================================
--- pkg/permute/R/allPerms.R	2013-11-05 22:47:44 UTC (rev 2654)
+++ pkg/permute/R/allPerms.R	2013-11-05 22:50:08 UTC (rev 2655)
@@ -35,17 +35,20 @@
         BLOCKS <- factor(rep(1, n))
 
     ## split v by blocks
-    spl <- split(v, BLOCKS)
+    spl <- split(seq_len(n), BLOCKS)
     nb <- length(spl) # number of blocks
 
     ## result object
     out <- vector(mode = "list", length = nb)
 
+    ## null-out Blocks in control
+    control2 <- update(control, blocks = NULL)
+
     ## loop over blocks and return allPerms on each block
     for (i in seq_along(spl)) {
         out[[i]] <-
             doAllPerms(spl[[i]], strataP, typeW, typeP, mirrorW,
-                       mirrorP, constantW, dimW, dimP, control,
+                       mirrorP, constantW, dimW, dimP, control2,
                        nperms = nperms)
     }
 
@@ -65,6 +68,7 @@
     out
 }
 
+
 `doAllPerms` <- function(obs, strataP, typeW, typeP, mirrorW, mirrorP,
                          constantW, dimW, dimP, control, nperms) {
     ## replicate a matrix by going via a list and bind together
@@ -75,6 +79,17 @@
 
     n <- length(obs)
 
+    ## subset strataP to take only the obs indices and drop the unused
+    ## levels
+    if (!is.null(strataP)) {
+        strataP <- droplevels(strataP[obs])
+    }
+
+    ## also need to update the $strata component of control
+    ## FIXME: this really should have a toplevel function to set/update
+    ## sub-components of control
+    control$plots$strata <- strataP
+
     ## permuting within?
     if (typeW != "none") {
         if(is.null(strataP)) {
@@ -108,7 +123,7 @@
             } else {
                 ## different permutations within blocks
                 nperms <- numPerms(sum(tab), control)
-                
+
                 ng <- length(tab)
                 ##pg <- unique(tab)
                 if(length(pg) > 1) {

Modified: pkg/permute/inst/ChangeLog
===================================================================
--- pkg/permute/inst/ChangeLog	2013-11-05 22:47:44 UTC (rev 2654)
+++ pkg/permute/inst/ChangeLog	2013-11-05 22:50:08 UTC (rev 2655)
@@ -17,6 +17,9 @@
 	* Within, Plots: as with `how()`, the matched call is now returned
 	as part of the list object, allowing desirable `update()` behaviour.
 
+	* allPerms, doAllPerms: now correctly work in presence of blocks,
+	and where there are no plots.
+
 Version 0.7-4
 
 	* Deprecated functions: Completed the deprecation of `permCheck()`