[Vegan-commits] r2456 - in pkg/permute: . R inst inst/tests man tests tests/Examples vignettes
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 1 04:56:35 CET 2013
Author: gsimpson
Date: 2013-03-01 04:56:33 +0100 (Fri, 01 Mar 2013)
New Revision: 2456
Added:
pkg/permute/R/Plots.R
pkg/permute/R/shuffle2.R
pkg/permute/R/shuffleSet2.R
pkg/permute/man/allUtils.Rd
pkg/permute/tests/Examples/
pkg/permute/tests/Examples/permute-Ex.Rout.save
Removed:
pkg/permute/man/allUtilis.Rd
Modified:
pkg/permute/DESCRIPTION
pkg/permute/NAMESPACE
pkg/permute/R/Blocks.R
pkg/permute/R/allFree.R
pkg/permute/R/allPerms.R
pkg/permute/R/getFoo-methods.R
pkg/permute/R/permControl.R
pkg/permute/R/shuffle-utils.R
pkg/permute/R/shuffle.R
pkg/permute/R/shuffleSet.R
pkg/permute/inst/ChangeLog
pkg/permute/inst/tests/test-shuffle.R
pkg/permute/man/allPerms.Rd
pkg/permute/man/numPerms.Rd
pkg/permute/man/permCheck.Rd
pkg/permute/man/shuffle.Rd
pkg/permute/man/shuffleSet.Rd
pkg/permute/vignettes/permutations.Rnw
Log:
push all updates, which breaks everything as I've added true Blocking capability, shuffle() works, as does almost all of shuffleSet(). Other user utility functions are very broken.
Modified: pkg/permute/DESCRIPTION
===================================================================
--- pkg/permute/DESCRIPTION 2013-02-28 21:02:32 UTC (rev 2455)
+++ pkg/permute/DESCRIPTION 2013-03-01 03:56:33 UTC (rev 2456)
@@ -1,11 +1,18 @@
Package: permute
Title: Functions for generating restricted permutations of data
-Version: 0.7-0
+Version: 0.7-2
Date: $Date$
Author: Gavin L. Simpson
Maintainer: Gavin L. Simpson <gavin.simpson at ucl.ac.uk>
Suggests: vegan (>= 2.0-0), testthat (>= 0.5)
-Description: The 'permute' package implements a set of restricted permutation designs for freely exchangeable, line transects (time series), and spatial grid designs plus permutation of blocks (groups of samples). 'permute' also allows split-plot designs, in which the whole-plots or split-plots or both can be freely-exchangeable or one of the restricted designs. The 'permute' package is modelled after the permutation schemes of Canoco 3.1 by Cajo ter Braak.
+Description: The 'permute' package implements a set of restricted permutation
+ designs for freely exchangeable, line transects (time series),
+ and spatial grid designs plus permutation of blocks (groups of
+ samples). 'permute' also allows split-plot designs, in which the
+ whole-plots or split-plots or both can be freely-exchangeable or
+ one of the restricted designs. The 'permute' package is modelled
+ after the permutation schemes of Canoco 3.1 (and later) by Cajo
+ ter Braak.
License: GPL-2
ByteCompile: true
URL: http://vegan.r-forge.r-project.org/
Modified: pkg/permute/NAMESPACE
===================================================================
--- pkg/permute/NAMESPACE 2013-02-28 21:02:32 UTC (rev 2455)
+++ pkg/permute/NAMESPACE 2013-03-01 03:56:33 UTC (rev 2456)
@@ -1,8 +1,8 @@
### Visible functions:
export(`allPerms`, `Blocks`, `numPerms`, `check`, `permCheck`,
- `permControl`, `permute`, `shuffle`, `Within`,
+ `permControl`, `permute`, `shuffle`, `Within`, `Plots`,
`shuffleFree`, `shuffleSeries`, `shuffleGrid`, `shuffleStrata`,
- `getBlocks`, `getWithin`, `getStrata`,
+ `getBlocks`, `getWithin`, `getStrata`, `getType`,
`shuffleSet`, `permuplot`)
### Imports: nobs() only exists in R 2.13.0 for import. We define the
@@ -35,3 +35,5 @@
S3method(`getWithin`, `permControl`)
S3method(`getStrata`, `default`)
S3method(`getStrata`, `permControl`)
+S3method(`getType`, `default`)
+S3method(`getType`, `permControl`)
Modified: pkg/permute/R/Blocks.R
===================================================================
--- pkg/permute/R/Blocks.R 2013-02-28 21:02:32 UTC (rev 2455)
+++ pkg/permute/R/Blocks.R 2013-03-01 03:56:33 UTC (rev 2456)
@@ -1,13 +1,6 @@
-`Blocks` <- function(type = c("free","series","grid","none"),
- mirror = FALSE, ncol = NULL, nrow = NULL)
-{
- if(missing(type))
- type <- "none"
- else
- type <- match.arg(type)
- out <- list(type = type, mirror = mirror,
- ncol = ncol, nrow = nrow)
+`Blocks` <- function(strata = NULL) {
+ out <- list(strata = strata)
## keep as list for now
##class(out) <- "Blocks"
- return(out)
+ out
}
Added: pkg/permute/R/Plots.R
===================================================================
--- pkg/permute/R/Plots.R (rev 0)
+++ pkg/permute/R/Plots.R 2013-03-01 03:56:33 UTC (rev 2456)
@@ -0,0 +1,9 @@
+`Plots` <- function(strata = NULL, type = c("free","series","grid","none"),
+ mirror = FALSE, ncol = NULL, nrow = NULL) {
+ type <- match.arg(type)
+ out <- list(strata = strata, type = type, mirror = mirror,
+ ncol = ncol, nrow = nrow)
+ ## keep as list for now
+ ##class(out) <- "Plots"
+ out
+}
Modified: pkg/permute/R/allFree.R
===================================================================
--- pkg/permute/R/allFree.R 2013-02-28 21:02:32 UTC (rev 2455)
+++ pkg/permute/R/allFree.R 2013-03-01 03:56:33 UTC (rev 2456)
@@ -1,11 +1,20 @@
-`allFree` <- function(n, v = 1:n)
-{
- if( n == 1 ) {
- matrix(v, 1, 1)
- } else {
- X <- NULL
- for(i in 1:n)
- X <- rbind(X, cbind(v[i], Recall(n-1, v[-i])))
- X
- }
+## `allFree` <- function(n, v = 1:n)
+## {
+## if( n == 1 ) {
+## matrix(v, 1, 1)
+## } else {
+## X <- NULL
+## for(i in 1:n)
+## X <- rbind(X, cbind(v[i], Recall(n-1, v[-i])))
+## X
+## }
+## }
+
+## Modified version of allFree() provided by Doug Bates
+## via personal email on 19 Jan 2012
+`allFree` <- function(n, v = seq_len(n)) {
+ if(n == 1L) return(array(v, c(1L, 1L)))
+ do.call(rbind,
+ lapply(seq_len(n),
+ function(i) cbind(v[i], allFree(n - 1L, v[-i]))))
}
Modified: pkg/permute/R/allPerms.R
===================================================================
--- pkg/permute/R/allPerms.R 2013-02-28 21:02:32 UTC (rev 2455)
+++ pkg/permute/R/allPerms.R 2013-03-01 03:56:33 UTC (rev 2456)
@@ -37,7 +37,7 @@
if(WI$constant) {
## same permutation in each block
pg <- unique(tab)
- ctrl.wi <- permControl(strata = NULL, within = WI)
+ ctrl.wi <- permControl(within = WI)
nperms <- numPerms(pg, ctrl.wi)
ord <- switch(type.wi,
free = allFree(pg),
@@ -62,7 +62,7 @@
## FIXME: this should not be needed once all checks are
## in place in check()
stop("Unbalanced grid designs are not supported")
- ctrl.wi <- permControl(strata = NULL, within = WI)
+ ctrl.wi <- permControl(within = WI)
sp <- split(v, STRATA)
res <- vector(mode = "list", length = ng)
add <- c(0, cumsum(tab)[1:(ng-1)])
@@ -90,7 +90,7 @@
unlist(sp), v))
} else {
## same number of observations per level of strata
- ctrl.wi <- permControl(strata = NULL, within = WI)
+ ctrl.wi <- permControl(within = WI)
np <- numPerms(pg, ctrl.wi)
ord <-
switch(type.wi,
@@ -126,6 +126,7 @@
if(type.wi == "none") {
res <- allStrata(n, control = control)
} else {
+ ## FIXME - this need updating to work with the new code
## permuting blocks AND within blocks
## need a local CTRL that just permutes blocks
ctrl.b <- permControl(strata = STRATA,
Modified: pkg/permute/R/getFoo-methods.R
===================================================================
--- pkg/permute/R/getFoo-methods.R 2013-02-28 21:02:32 UTC (rev 2455)
+++ pkg/permute/R/getFoo-methods.R 2013-03-01 03:56:33 UTC (rev 2456)
@@ -1,4 +1,6 @@
-## Extractor functions for blocks and within
+## Extractor functions for blocks, plots and within, plus strata
+
+## Blocks
getBlocks <- function(object, ...) {
UseMethod("getBlocks")
}
@@ -11,6 +13,20 @@
object$blocks
}
+## Plots
+getPlots <- function(object, ...) {
+ UseMethod("getPlots")
+}
+
+getPlots.default <- function(object, ...) {
+ stop("No default method for 'getPlots()'")
+}
+
+getPlots.permControl <- function(object, ...) {
+ object$plots
+}
+
+## Within plots
getWithin <- function(object, ...) {
UseMethod("getWithin")
}
@@ -23,6 +39,7 @@
object$within
}
+## Strata
getStrata <- function(object, ...) {
UseMethod("getStrata")
}
@@ -31,9 +48,40 @@
stop("No default method for 'getStrata()'")
}
-getStrata.permControl <- function(object, ...) {
- object$strata
+getStrata.permControl <- function(object,
+ which = c("plots","blocks"),
+ drop = TRUE, ...) {
+ which <- match.arg(which)
+ if(isTRUE(all.equal(which, "plots")))
+ strata <- object$plots$strata
+ else if(isTRUE(all.equal(which, "blocks")))
+ strata <- object$blocks$strata
+ else
+ stop("Ambiguous `which`")
+ if(isTRUE(drop) && !is.null(strata))
+ strata <- droplevels(strata)
+ strata
}
+## Get type of permutation
+getType <- function(object, ...) {
+ UseMethod("getType")
+}
+
+getType.default <- function(object, ...) {
+ stop("No default method for 'getType()'")
+}
+
+getType.permControl <- function(object,
+ which = c("plots","within"), ...) {
+ which <- match.arg(which)
+ if(isTRUE(all.equal(which, "plots")))
+ type <- getPlots(object)$type
+ else if(isTRUE(all.equal(which, "within")))
+ type <- getWithin(object)$type
+ else
+ stop("Ambiguous `which`")
+ type
+}
## suppose we can also have setBlocks() etc...
## to update the control object in place....
Modified: pkg/permute/R/permControl.R
===================================================================
--- pkg/permute/R/permControl.R 2013-02-28 21:02:32 UTC (rev 2455)
+++ pkg/permute/R/permControl.R 2013-03-01 03:56:33 UTC (rev 2456)
@@ -1,12 +1,29 @@
-`permControl` <- function(strata = NULL, nperm = 199, complete = FALSE,
- within = Within(),
+## `permControl` <- function(strata = NULL, nperm = 199, complete = FALSE,
+## within = Within(),
+## blocks = Blocks(),
+## maxperm = 9999, minperm = 99,
+## all.perms = NULL,
+## observed = FALSE)
+## {
+## out <- list(strata = strata, nperm = nperm, complete = complete,
+## within = within, blocks = blocks,
+## maxperm = maxperm, minperm = minperm,
+## all.perms = all.perms, observed = observed,
+## name.strata = deparse(substitute(strata)))
+## class(out) <- "permControl"
+## return(out)
+## }
+
+`permControl` <- function(within = Within(),
+ plots = Plots(),
blocks = Blocks(),
+ nperm = 199, complete = FALSE,
maxperm = 9999, minperm = 99,
all.perms = NULL,
observed = FALSE)
{
- out <- list(strata = strata, nperm = nperm, complete = complete,
- within = within, blocks = blocks,
+ out <- list(within = within, plots = plots, blocks = blocks,
+ nperm = nperm, complete = complete,
maxperm = maxperm, minperm = minperm,
all.perms = all.perms, observed = observed,
name.strata = deparse(substitute(strata)))
Modified: pkg/permute/R/shuffle-utils.R
===================================================================
--- pkg/permute/R/shuffle-utils.R 2013-02-28 21:02:32 UTC (rev 2455)
+++ pkg/permute/R/shuffle-utils.R 2013-03-01 03:56:33 UTC (rev 2456)
@@ -70,3 +70,15 @@
`shuffleFree` <- function(x, size) {
sample.int(x, size, replace = FALSE)
}
+
+## wrapper function when shuffling without any strata at all at any level
+`shuffleNoStrata` <- function(n, control) {
+ type <- control$within$type
+ switch(type,
+ "free" = shuffleFree(n, n),
+ "series" = shuffleSeries(seq_len(n), mirror = control$within$mirror),
+ "grid" = shuffleGrid(nrow = control$within$nrow,
+ ncol = control$within$ncol, mirror = control$within$mirror),
+ "none" = seq_len(n)
+ )
+}
Modified: pkg/permute/R/shuffle.R
===================================================================
--- pkg/permute/R/shuffle.R 2013-02-28 21:02:32 UTC (rev 2455)
+++ pkg/permute/R/shuffle.R 2013-03-01 03:56:33 UTC (rev 2456)
@@ -1,16 +1,95 @@
-`shuffle` <- function (n, control = permControl()) {
- ## If no strata then permute all samples using stated scheme
- if(is.null(control$strata)) {
- out <-
- switch(control$within$type,
- "free" = shuffleFree(n, n),
- "series" = shuffleSeries(seq_len(n),
- mirror = control$within$mirror),
- "grid" = shuffleGrid(nrow = control$within$nrow,
- ncol = control$within$ncol,
- mirror = control$within$mirror),
- "none" = seq_len(n)
- )
+## `shuffle` <- function (n, control = permControl()) {
+## ## If no strata then permute all samples using stated scheme
+## if(is.null(control$strata)) {
+## out <-
+## switch(control$within$type,
+## "free" = shuffleFree(n, n),
+## "series" = shuffleSeries(seq_len(n),
+## mirror = control$within$mirror),
+## "grid" = shuffleGrid(nrow = control$within$nrow,
+## ncol = control$within$ncol,
+## mirror = control$within$mirror),
+## "none" = seq_len(n)
+## )
+## } else {
+## ## If strata present, either permute samples, strata or both
+
+## ## permute strata?
+## if(control$blocks$type == "none") {
+## out <- seq_len(n)
+## } else {
+## flip <- runif(1L) < 0.5 ## why are we doing this? Null better?
+## out <- shuffleStrata(control$strata,
+## type = control$blocks$type,
+## mirror = control$blocks$mirror,
+## flip = flip,
+## nrow = control$blocks$nrow,
+## ncol = control$blocks$ncol)
+## }
+## ## permute the samples within strata?
+## if(control$within$type != "none") {
+## tab <- table(control$strata[out])
+## ## the levels of the strata
+## inds <- names(tab)
+## ## same permutation within each level of strata?
+## if(control$within$constant) {
+## if(control$within$type == "free") {
+## n <- unique(tab)[1L]
+## same.rand <- shuffleFree(n, n)
+## } else if(control$within$type == "series") {
+## start <- shuffleFree(n / length(inds), 1L)
+## flip <- runif(1L) < 0.5
+## } else if(control$within$type == "grid") {
+## start.row <- shuffleFree(control$within$nrow, 1L)
+## start.col <- shuffleFree(control$within$ncol, 1L)
+## flip <- runif(2L) < 0.5
+## }
+## } else {
+## start <- start.row <- start.col <- flip <- NULL
+## }
+## tmp <- out
+## ## for each level of strata, permute
+## for (is in inds) {
+## ## must re-order strata here on basis of out as they
+## ## may have been permuted above
+## MATCH <- control$strata[out] == is
+## gr <- out[MATCH]
+## if ((n.gr <- length(gr)) > 1) {
+## tmp[which(MATCH)] <-
+## switch(control$within$type,
+## "free" =
+## if(control$within$constant) {
+## gr[same.rand]
+## } else {
+## out[gr][shuffleFree(n.gr, n.gr)]
+## },
+## "series" =
+## gr[shuffleSeries(seq_len(n.gr),
+## mirror = control$within$mirror,
+## start = start, flip = flip)],
+## "grid" =
+## gr[shuffleGrid(nrow = control$within$nrow,
+## ncol = control$within$ncol,
+## mirror = control$within$mirror,
+## start.row = start.row,
+## start.col = start.col,
+## flip = flip)]
+## )
+## }
+## }
+## out <- tmp
+## }
+## }
+## out
+## }
+
+`shuffle2` <- function (n, control = permControl()) {
+ ## capture strata data
+ Pstrata <- getStrata(control, which = "plots")
+ Bstrata <- getStrata(control, which = "blocks")
+ ## if no strata at all permute all samples using stated scheme
+ if(is.null(Pstrata) && is.null(Bstrata)) {
+ out <- shuffleNoStrata(n, control)
} else {
## If strata present, either permute samples, strata or both
Added: pkg/permute/R/shuffle2.R
===================================================================
--- pkg/permute/R/shuffle2.R (rev 0)
+++ pkg/permute/R/shuffle2.R 2013-03-01 03:56:33 UTC (rev 2456)
@@ -0,0 +1,113 @@
+## new version of shuffle() that allows for blocking
+`shuffle` <- function(n, control = permControl()) {
+ ## get blocking, if any
+ Block <- getStrata(control, which = "blocks")
+ if(is.null(Block))
+ Block <- factor(rep(1, n))
+
+ sn <- seq_len(n) ## sequence of samples in order of input
+
+ ## split sn on basis of Block
+ spln <- split(sn, Block)
+ nb <- length(spln) ## number of blocks
+
+ ## result list
+ out <- vector(mode = "list", length = nb)
+
+ ## loop over spln and shuffle in each split
+ for(i in seq_len(nb)) {
+ out[[i]] <- doShuffle(spln[[i]], control)
+ }
+ out <- unsplit(out, Block) ## undo the original splitting
+ out
+}
+
+`doShuffle` <- function(ind, control) {
+ ## collect strata at Plot level
+ Pstrata <- getStrata(control, which = "plots", drop = TRUE)
+ plotCTRL <- getPlots(control)
+
+ n <- length(ind)
+ sn <- seq_len(n)
+
+ ## if no strata at Plot level permute all samples using stated scheme
+ if(is.null(Pstrata)) {
+ perm <- shuffleNoStrata(n, control)
+ } else {
+ typeP <- getType(control, which = "plots")
+ typeW <- getType(control, which = "within")
+
+ ## permute Plot strata?
+ if(isTRUE(all.equal(typeP, "none"))) { ## NO
+ perm <- sn
+ } else { ## YES
+ flip <- runif(1L) < 0.5 ## logical, passed on & used only if mirroring
+ perm <- shuffleStrata(Pstrata[ind], ## take only the ind values
+ type = typeP,
+ mirror = plotCTRL$mirror,
+ flip = flip,
+ nrow = plotCTRL$nrow,
+ ncol = plotCTRL$ncol)
+ }
+
+ ## permute the samples within Plot strata
+ if(!isTRUE(all.equal(typeW, "none"))) { ## NOTE the `!`
+ ## house keeping to track permuted strata - used later
+ tab <- table(Pstrata[ind][perm])
+ levs <- names(tab) ## levels of Plot strata in this split
+
+ ## use same permutation within each level of strata?
+ withinCTRL <- getWithin(control)
+ CONSTANT <- withinCTRL$constant
+ if(isTRUE(CONSTANT)) {
+ if(isTRUE(all.equal(typeW, "free"))) {
+ N <- unique(tab)[1L]
+ same.rand <- shuffleFree(N, N)
+ } else if(isTRUE(all.equal(typeW, "series"))) {
+ start <- shuffleFree(n / length(levs), 1L)
+ flip <- runif(1L) < 0.5
+ } else if(isTRUE(all.equal(typeW, "grid"))) {
+ start.row <- shuffleFree(withinCTRL$nrow, 1L)
+ start.col <- shuffleFree(withinCTRL$ncol, 1L)
+ flip <- runif(2L) < 0.5
+ }
+ } else {
+ start <- start.row <- start.col <- flip <- NULL
+ }
+
+ ## copy perm at this stage
+ tmp <- perm
+
+ ## for each level of strata in this split, shuffle
+ for(lv in levs) {
+ ## must re-order strata here on basis of out as they
+ ## may have been permuted above
+ MATCH <- Pstrata[ind][perm] == lv
+ gr <- perm[MATCH]
+ if((n.gr <- length(gr)) > 1) {
+ tmp[which(MATCH)] <-
+ switch(typeW,
+ "free" = if(isTRUE(CONSTANT)) {
+ gr[same.rand]
+ } else {
+ perm[gr][shuffleFree(n.gr, n.gr)]
+ },
+ "series" =
+ gr[shuffleSeries(seq_len(n.gr),
+ mirror = withinCTRL$mirror,
+ start = start, flip = flip)],
+ "grid" =
+ gr[shuffleGrid(nrow = withinCTRL$nrow,
+ ncol = withinCTRL$ncol,
+ mirror = withinCTRL$mirror,
+ start.row = start.row,
+ start.col = start.col,
+ flip = flip)]
+ )
+ }
+ }
+ perm <- tmp
+ }
+ }
+ ind[perm]
+}
Modified: pkg/permute/R/shuffleSet.R
===================================================================
--- pkg/permute/R/shuffleSet.R 2013-02-28 21:02:32 UTC (rev 2455)
+++ pkg/permute/R/shuffleSet.R 2013-03-01 03:56:33 UTC (rev 2456)
@@ -1,4 +1,4 @@
-`shuffleSet` <- function(n, nset = 1, control = permControl()) {
+`shuffleSet2` <- function(n, nset = 1, control = permControl()) {
Set <- matrix(nrow = nset, ncol = n)
WI <- getWithin(control)
strata <- getStrata(control)
Added: pkg/permute/R/shuffleSet2.R
===================================================================
--- pkg/permute/R/shuffleSet2.R (rev 0)
+++ pkg/permute/R/shuffleSet2.R 2013-03-01 03:56:33 UTC (rev 2456)
@@ -0,0 +1,143 @@
+## new version of shuffleSet() that allows for blocking
+`shuffleSet` <- function(n, nset = 1, control = permControl()) {
+ ## get blocking, if any
+ Block <- getStrata(control, which = "blocks")
+ if(is.null(Block))
+ Block <- factor(rep(1, n))
+
+ sn <- seq_len(n) ## sequence of samples in order of input
+
+ ## split sn on basis of Block
+ spln <- split(sn, Block)
+ nb <- length(spln) ## number of blocks
+
+ ## result list
+ out <- vector(mode = "list", length = nb)
+
+ ## loop over spln and shuffle in each split
+ for(i in seq_len(nb)) {
+ out[[i]] <- doShuffleSet(spln[[i]], nset = nset, control)
+ }
+ out <- do.call(cbind, out) ## undo the original splitting
+ out
+}
+
+`doShuffleSet` <- function(ind, nset = 1, control) {
+ ## collect strata at Plot level
+ Pstrata <- getStrata(control, which = "plots", drop = TRUE)
+ plotCTRL <- getPlots(control)
+ typeP <- getType(control, which = "plots")
+
+ ## collect the within control object
+ withinCTRL <- getWithin(control)
+ typeW <- getType(control, which = "within")
+
+ n <- length(ind)
+ sn <- seq_len(n)
+
+ ## result object
+ Set <- matrix(nrow = nset, ncol = n)
+
+ ## if no strata at Plot level permute all samples using stated scheme
+ if(is.null(Pstrata)) {
+ ## If no strata at plot then permute all samples using stated scheme
+ Args <- switch(typeW,
+ "free" = list(x = n, size = n),
+ "series" = list(x = seq_len(n), mirror = withinCTRL$mirror),
+ "grid" = list(nrow = withinCTRL$nrow, ncol = withinCTRL$ncol,
+ mirror = withinCTRL$mirror))
+ FUN <- switch(typeW,
+ "free" = shuffleFree,
+ "series" = shuffleSeries,
+ "grid" = shuffleGrid)
+ if(withinCTRL$type == "none") {
+ Set[] <- rep(sn, each = nset)
+ } else {
+ for(i in seq_len(nset)) {
+ Set[i,] <- do.call(FUN, Args)
+ }
+ }
+ } else {
+ ## If strata at Plot level present, either permute samples, Plots or both
+
+ ## permute strata at Plot level?
+ if(isTRUE(all.equal(typeP, "none"))) {
+ Set[] <- rep(sn, each = nset)
+ } else {
+ for(i in seq_len(nset)) {
+ Set[i,] <- do.call(shuffleStrata,
+ list(strata = Pstrata,
+ type = typeP,
+ mirror = plotCTRL$mirror,
+ flip = NULL, ## runif(1L) < 0.5 ??
+ nrow = plotCTRL$nrow,
+ ncol = plotCTRL$ncol))
+ }
+ }
+
+ tmp <- Set
+
+ ## permute the samples within Plot strata
+ if(!isTRUE(all.equal(typeW, "none"))) {
+ for(i in seq_len(nset)) {
+ tab <- table(Pstrata[ind][Set[i,]])
+ ## the levels of the Plot strata
+ levs <- names(tab)
+
+ ## same permutation within each level of the Plot strata?
+ if(withinCTRL$constant) {
+ if(isTRUE(all.equal(typeW, "free"))) {
+ n <- unique(tab)[1L]
+ same.rand <- shuffleFree(n, n)
+ } else if(isTRUE(all.equal(typeW, "series"))) {
+ start <- shuffleFree(n / length(levs), 1L)
+ flip <- runif(1L) < 0.5 ## FIXME this should be moved out of the loop
+ } else if(isTRUE(all.equal(typeW, "grid"))) {
+ start.row <- shuffleFree(withinCTRL$nrow, 1L)
+ start.col <- shuffleFree(withinCTRL$ncol, 1L)
+ flip <- runif(2L) < 0.5 ## FIXME this should be moved out of the loop
+ }
+ } else {
+ start <- start.row <- start.col <- flip <- NULL
+ }
+
+ ## for each level of strata, permute
+ for(lv in levs) {
+ ## must re-order strata here on basis of Ser as they
+ ## may have been permuted above
+ MATCH <- Pstrata[ind][Set[i,]] == lv
+ gr <- Set[i,][MATCH]
+ if((n.gr <- length(gr)) > 1) {
+ if(withinCTRL$constant && isTRUE(all.equal(typeW, "free"))) {
+ tmp[i,][which(MATCH)] <- gr[same.rand]
+ } else {
+ Args <-
+ switch(typeW,
+ "free" = list(x = n.gr, size = n.gr),
+ "series" = list(x = seq_len(n.gr),
+ mirror = withinCTRL$mirror,
+ start = start,
+ flip = flip),
+ "grid" = list(nrow = withinCTRL$nrow,
+ ncol = withinCTRL$ncol,
+ mirror = withinCTRL$mirror,
+ start.row = start.row,
+ start.col = start.col,
+ flip = flip))
+ FUN <-
+ switch(typeW,
+ "free" = shuffleFree,
+ "series" = shuffleSeries,
+ "grid" = shuffleGrid)
+ tmp[i,][which(MATCH)] <- gr[do.call(FUN, Args)]
+ }
+ }
+ }
+ }
+ Set <- tmp
+ }
+ }
+ out <- Set ## have to copy or next line fails
+ out[] <- ind[Set]
+ out
+}
Modified: pkg/permute/inst/ChangeLog
===================================================================
--- pkg/permute/inst/ChangeLog 2013-02-28 21:02:32 UTC (rev 2455)
+++ pkg/permute/inst/ChangeLog 2013-03-01 03:56:33 UTC (rev 2456)
@@ -2,6 +2,39 @@
permute ChangeLog
+Version 0.7-2
+
+ * Major API change: Added capability to handle true blocking
+ constraints, as suggested by Cajo ter Braak. We now have
+
+ o Blocks: samples are *never* permuted between blocks. Blocks
+ can't be permuted either.
+ o Plots: these define groups of samples, for example the
+ whole plots in a split-plot design, or repeated measures
+ on a set of sites. The sites are the "plots". Plots can
+ be permuted using any of the restricted schemes offered
+ in permute.
+ o Within: these are the samples, the rows in the data set.
+ They can be nested in Plots and/or in Blocks.
+
+ This capability has made it into permControl(), shuffle() and
+ shuffleSet(), though the latter certainly has one major bug
+ in the case where there is more than one Block.
+
+ Most other functionality is broken as the above change has
+ altered the permControl object in a way that is not backwards
+ compatible.
+
+ Note that the 0.7.x branch is a development branch and should
+ not be used in ernest until I work through all the implications
+ of this change. Rest assured, I won't be doing this again!
+
+Version 0.7-1
+
+ * allPerms: implement Doug Bates version which simplifies and
+ speeds up the code. A faste RcppEigen-based version also exists
+ but will need larger changes to the package to implement.
+
Version 0.7-0
* Vignette: silly typo is example code illustrating shuffle().
Modified: pkg/permute/inst/tests/test-shuffle.R
===================================================================
--- pkg/permute/inst/tests/test-shuffle.R 2013-02-28 21:02:32 UTC (rev 2455)
+++ pkg/permute/inst/tests/test-shuffle.R 2013-03-01 03:56:33 UTC (rev 2456)
@@ -24,12 +24,11 @@
## 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
+ ## permuting levels of Plots 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"))
+ Plot <- factor(rep(1:4, 5))
+ CTRL <- permControl(plots = Plots(strata = Plot, type = "free"),
+ within = Within(type = "none"))
n <- 20
set.seed(2)
result <- shuffle(n, CTRL)
@@ -40,5 +39,5 @@
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))
+ expect_that(Plot[result], is_identical_to(out2))
})
Modified: pkg/permute/man/allPerms.Rd
===================================================================
--- pkg/permute/man/allPerms.Rd 2013-02-28 21:02:32 UTC (rev 2455)
+++ pkg/permute/man/allPerms.Rd 2013-03-01 03:56:33 UTC (rev 2456)
@@ -67,6 +67,7 @@
}
\author{Gavin Simpson}
\examples{
+\dontrun{ % FIXME - this needs updating for blocks
## allPerms can work with a vector
vec <- c(3,4,5)
allPerms(vec) ## free permutation
@@ -89,13 +90,14 @@
numPerms(seq_len(Nobs), control = ctrl)
(tmp3 <- allPerms(Nobs, control = ctrl, observed = TRUE))
(tmp4 <- allPerms(Nobs, control = ctrl))
+}
-%\dontrun{
+\dontrun{
## prints out details of the permutation scheme as
## well as the matrix of permutations
% FIXME: uncomment the two lines below when we remove old permute
% code from vegan and have vegan depend on permute
summary(tmp3)
summary(tmp4)
-%}
}
+}
Deleted: pkg/permute/man/allUtilis.Rd
===================================================================
--- pkg/permute/man/allUtilis.Rd 2013-02-28 21:02:32 UTC (rev 2455)
+++ pkg/permute/man/allUtilis.Rd 2013-03-01 03:56:33 UTC (rev 2456)
@@ -1,53 +0,0 @@
-\name{allUtils}
-\alias{allFree}
-\alias{allSeries}
-\alias{allGrid}
-\alias{allStrata}
-
-\title{Utility functions for complete enumeration of all possible
- permutations}
-
-\description{
- Utility functions to return the set of all permutations under
- different designs. For most practical applications, i.e. to combine
- designs permuting blocks and/or within blocks function
- \code{\link{allPerms}} will be required.
-}
-
-\usage{
-allFree(n, v = 1:n)
-
-allSeries(n, nperms, mirror = FALSE)
-
-allGrid(n, nperms, nr, nc, mirror, constant)
-
-allStrata(n, control)
-}
-
-\arguments{
- \item{n}{the number of observations.}
- \item{v}{numeric; vector of indices. Default is \code{1:n}.}
- \item{nperms}{numeric; number of possible permutations.}
- \item{mirror}{logical; mirroring of permutations allowed?}
- \item{nr,nc}{integer; number of rows and columns of grid designs.}
- \item{constant}{logical; same permutation within each block?}
- \item{control}{a list of control values describing properties of the
- permutation design, as returned by a call to
- \code{\link{permControl}}.}
-}
-
-\details{
- These are utility functions and aren't designed for casual
- use. \code{\link{allPerms}} should be used instead.
-
- Details on usage of these functions can be found in
- \code{\link{allPerms}}.
-}
-
-\value{
- A matrix of all possible permutations of \code{n} observations or of
- \code{v}, given the provided options.
-}
-
-\author{Gavin Simpson}
-
Copied: pkg/permute/man/allUtils.Rd (from rev 2310, pkg/permute/man/allUtilis.Rd)
===================================================================
--- pkg/permute/man/allUtils.Rd (rev 0)
+++ pkg/permute/man/allUtils.Rd 2013-03-01 03:56:33 UTC (rev 2456)
@@ -0,0 +1,53 @@
+\name{allUtils}
+\alias{allFree}
+\alias{allSeries}
+\alias{allGrid}
+\alias{allStrata}
+
+\title{Utility functions for complete enumeration of all possible
+ permutations}
+
+\description{
+ Utility functions to return the set of all permutations under
+ different designs. For most practical applications, i.e. to combine
+ designs permuting blocks and/or within blocks function
+ \code{\link{allPerms}} will be required.
+}
+
+\usage{
+allFree(n, v = seq_len(n))
+
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/vegan -r 2456
More information about the Vegan-commits
mailing list