[Vegan-commits] r1978 - pkg/permute/inst/tests

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

Author: gsimpson
Date: 2011-11-01 15:32:42 +0100 (Tue, 01 Nov 2011)
New Revision: 1978

Modified:
   pkg/permute/inst/tests/test-shuffle.R
Log:
add a test for Cajo's example that failed prior to r1972

Modified: pkg/permute/inst/tests/test-shuffle.R
===================================================================
--- pkg/permute/inst/tests/test-shuffle.R	2011-11-01 14:10:58 UTC (rev 1977)
+++ pkg/permute/inst/tests/test-shuffle.R	2011-11-01 14:32:42 UTC (rev 1978)
@@ -20,3 +20,25 @@
     expect_that(shuffle(1, control = ctrl), is_identical_to(1L))
     expect_that(shuffle(3, control = ctrl), is_identical_to(c(1L, 2L, 3L)))
 })
+
+## test what shuffle returns when permuting only the strata
+## must *not* assume that the samples are in contiguous blocks
+test_that("shuffle() works for non-contigous blocks of samples", {
+    ## permuting levels of block instead of observations
+    ## non-contiguous blocks - checks that r1972 continues to work
+    block <- factor(rep(1:4, 5))
+    CTRL <- permControl(strata = block,
+                        blocks = Blocks(type = "free"),
+                        within = Within(type = "none"))
+    n <- 20
+    set.seed(2)
+    result <- shuffle(n, CTRL)
+    out1 <- as.integer(c( 3, 2, 1, 4,
+                          7, 6, 5, 8,
+                         11,10, 9,12,
+                         15,14,13,16,
+                         19,18,17,20))
+    expect_that(result, is_identical_to(out1))
+    out2 <- factor(as.integer(rep(c(3,2,1,4), 5)), levels = 1:4)
+    expect_that(block[result], is_identical_to(out2))
+})