library("testthat") library("permute") context("Testing shuffleSet()") ## test that shuffleSet interleves the separate block-level ## permutations correctly back into the original ordering ## This always generates odd, even, odd, ..., numbered vector ## of observations, hence when we take the modulus 2 we get ## a vector of 1,0,1,0,1,... test_that("shuffleSet interleves block-level perms correctly", { gr <- factor(rep(1:2, length=20)) ctrl <- how(nperm = 5, blocks = gr) p <- shuffleSet(20, control = ctrl) %% 2 y <- rep(c(1L, 0L), length.out = ncol(p)) nc <- ncol(p) for (i in seq_len(nrow(p))) { expect_that(p[i, ], equals(y)) } }) ## test that nset permutations are always returned if ## make = FALSE in how() test_that( "shuffleSet returns exactly nset permutations when make == FALSE", { ## simple random permutation h <- how(make = FALSE) ss <- shuffleSet(n = 4, nset = 10, control = h) expect_that(nrow(ss), equals(10)) ## time series h <- how(within = Within(type = "series"), make = FALSE) ss <- shuffleSet(n = 20, nset = 15, control = h) expect_that(nrow(ss), equals(15)) }) ## test that shuffleSet always returns a matrix, even for nset == 1 test_that("shuffleSet returns a matrix even for nset == 1", { h <- how() ss <- shuffleSet(25, nset = 1, control = h) expect_that(ss, is_a("matrix")) }) test_that("shuffle can permute both plots and within in presence of blocks", { ## Example from @LindsayVass on github #9 control <- how(within = Within(type = "free"), plots = Plots(strata = rep(gl(2,7),2), type = "free"), blocks = gl(2, 14)) permSet <- shuffleSet(28, 100, control = control) expect_that(nrow(permSet), is_identical_to(100L)) expect_that(ncol(permSet), is_identical_to(28L)) expect_that(permSet, is_a("permutationMatrix")) expect_that(permSet, is_a("matrix")) }) test_that("print method for permutationMatrix works", { h <- how() perms <- shuffleSet(10, nset = 10, control = h) expect_output(print(perms), regexp = "No. of Permutations:") h <- how(blocks = gl(5,10)) perms <- shuffleSet(50, nset = 20, control = h) expect_output(print(perms), regexp = "Restricted by Blocks:") expect_output(print(perms), regexp = "blocks;") h <- how(plots = Plots(strata = gl(5,10))) perms <- shuffleSet(50, nset = 20, control = h) expect_output(print(perms), regexp = "Restricted by Plots:") expect_output(print(perms), regexp = "plots;") h <- how(plots = Plots(strata = gl(10,10)), blocks = gl(2, 50)) perms <- shuffleSet(100, nset = 20, control = h) expect_output(print(perms), regexp = "Restricted by Plots:") expect_output(print(perms), regexp = "plots & blocks;") h <- how(within = Within(type = "series", mirror = TRUE)) perms <- shuffleSet(10, nset = 20, control = h) expect_output(print(perms), regexp = "; mirrored") h <- how(within = Within(type = "series", constant = TRUE), plots = Plots(strata = gl(2, 5), type = "series", mirror = TRUE)) perms <- shuffleSet(10, nset = 20, control = h) expect_output(print(perms), regexp = "; same permutation") }) test_that("constant within plots works", { ## These need check = FALSE to stop allPerms doing the generation ## which doesn't actually call doShuffleSet. Check using both FALSE ## and the default, default first fac <- gl(4, 5) nset <- 10L ## series permutations ctrl <- how(within = Within(type = "series", constant = TRUE), plots = Plots(strata = fac, type = "none")) perm <- shuffleSet(length(fac), nset, control = ctrl) expect_identical(ncol(perm), length(fac)) expect_identical(ncol(perm), 20L) expect_identical(nrow(perm), 4L) ## only 4 permutations! expect_is(perm, "matrix") expect_is(perm, "permutationMatrix") expect_output(print(perm), regexp = "; same permutation") expect_output(print(perm), regexp = "Nested in: plots; Sequence;") ## free/randomisation ctrl <- how(within = Within(type = "free", constant = TRUE), plots = Plots(strata = fac, type = "none")) perm <- shuffleSet(length(fac), nset, control = ctrl) expect_identical(ncol(perm), length(fac)) expect_identical(ncol(perm), 20L) expect_identical(nrow(perm), nset) expect_identical(nrow(perm), 10L) expect_is(perm, "matrix") expect_is(perm, "permutationMatrix") expect_output(print(perm), regexp = "; same permutation") expect_output(print(perm), regexp = "Nested in: plots; Randomised;") ## spatial grid 3x3 fac <- gl(4, 9) ctrl <- how(within = Within(type = "grid", nrow = 3, ncol = 3, constant = TRUE), plots = Plots(strata = fac, type = "none")) perm <- shuffleSet(length(fac), nset, control = ctrl) expect_identical(ncol(perm), length(fac)) expect_identical(ncol(perm), 36L) expect_identical(nrow(perm), 8L) expect_is(perm, "matrix") expect_is(perm, "permutationMatrix") expect_output(print(perm), regexp = "; same\npermutation") expect_output(print(perm), regexp = "; Spatial grid: 3r, 3c") ## now with check = FALSE --- this is going to generate duplicate permutations fac <- gl(4, 5) nset <- 10L ## series permutations ctrl <- how(within = Within(type = "series", constant = TRUE), plots = Plots(strata = fac, type = "none")) perm <- shuffleSet(length(fac), nset, control = ctrl, check = FALSE) expect_identical(ncol(perm), length(fac)) expect_identical(ncol(perm), 20L) expect_identical(nrow(perm), nset) expect_identical(nrow(perm), 10L) expect_is(perm, "matrix") expect_is(perm, "permutationMatrix") expect_output(print(perm), regexp = "; same permutation") expect_output(print(perm), regexp = "Nested in: plots; Sequence;") ## free/randomisation ctrl <- how(within = Within(type = "free", constant = TRUE), plots = Plots(strata = fac, type = "none")) perm <- shuffleSet(length(fac), nset, control = ctrl, check = FALSE) expect_identical(ncol(perm), length(fac)) expect_identical(ncol(perm), 20L) expect_identical(nrow(perm), nset) expect_identical(nrow(perm), 10L) expect_is(perm, "matrix") expect_is(perm, "permutationMatrix") expect_output(print(perm), regexp = "; same permutation") expect_output(print(perm), regexp = "Nested in: plots; Randomised;") ## spatial grid 3x3 fac <- gl(4, 9) ctrl <- how(within = Within(type = "grid", nrow = 3, ncol = 3, constant = TRUE), plots = Plots(strata = fac, type = "none")) perm <- shuffleSet(length(fac), nset, control = ctrl, check = FALSE) expect_identical(ncol(perm), length(fac)) expect_identical(ncol(perm), 36L) expect_identical(nrow(perm), 10L) expect_identical(nrow(perm), nset) expect_is(perm, "matrix") expect_is(perm, "permutationMatrix") expect_output(print(perm), regexp = "; same\npermutation") expect_output(print(perm), regexp = "; Spatial grid: 3r, 3c") }) test_that("shuffelSet works with objects passed to n", { obj <- 1:4 p <- shuffleSet(obj, 10L) expect_is(p, "permutationMatrix") expect_identical(nrow(p), 10L) obj <- as.integer(1:4) p <- shuffleSet(obj, 10L) expect_is(p, "permutationMatrix") expect_identical(nrow(p), 10L) obj <- as.factor(1:4) p <- shuffleSet(obj, 10L) expect_is(p, "permutationMatrix") expect_identical(nrow(p), 10L) obj <- letters[1:4] p <- shuffleSet(obj, 10L) expect_is(p, "permutationMatrix") expect_identical(nrow(p), 10L) obj <- matrix(1:16, ncol = 4, nrow = 4) p <- shuffleSet(obj, 10L) expect_is(p, "permutationMatrix") expect_identical(nrow(p), 10L) obj <- data.frame(A = 1:4, B = letters[1:4]) p <- shuffleSet(obj, 10L) expect_is(p, "permutationMatrix") expect_identical(nrow(p), 10L) }) test_that("Issue 19: shuffleSet with nset=1 never regresses", { TreatmentLevels <- 3 Animals <- 4 TimeSteps <- 5 AnimalID <- rep(letters[seq_len(Animals)], each = TreatmentLevels * TimeSteps) Time <- rep(seq_len(TimeSteps), Animals = TreatmentLevels) ## Treatments were given in different order per animal Day <- rep(c(1,2,3,2,3,1,3,2,1,2,3,1), each = TimeSteps) Treatment <- rep(rep(LETTERS[seq_len(TreatmentLevels)], each = TimeSteps), Animals) dataset <- as.data.frame(cbind(AnimalID, Treatment, Day, Time)) ctrl <- with(dataset, how(blocks = AnimalID, plots = Plots(strata = Day, type = "free"), within = Within(type = "none"), nperm = 999)) ## This should return a matrix p <- shuffleSet(60, nset = 1, control = ctrl) expect_is(p, "matrix") expect_identical(nrow(p), 1L) }) test_that("Issue 23: if complete = TRUE update nperm", { ctrl <- how(complete = TRUE, minperm = 100) vec <- 1:6 np <- numPerms(vec, control = ctrl) ap <- allPerms(vec, control = ctrl) p <- shuffleSet(length(vec), control = ctrl) ##expect_identical(NROW(p), np - 1L) expect_identical(NROW(p), NROW(ap)) })
Generated by dwww version 1.15 on Sat May 18 13:33:48 CEST 2024.