[Vegan-commits] r2646 - pkg/permute/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Nov 5 05:23:55 CET 2013
Author: gsimpson
Date: 2013-11-05 05:23:55 +0100 (Tue, 05 Nov 2013)
New Revision: 2646
Modified:
pkg/permute/R/shuffle2.R
Log:
clears blocks component for within-block permuting
Modified: pkg/permute/R/shuffle2.R
===================================================================
--- pkg/permute/R/shuffle2.R 2013-11-04 22:50:42 UTC (rev 2645)
+++ pkg/permute/R/shuffle2.R 2013-11-05 04:23:55 UTC (rev 2646)
@@ -1,113 +1,120 @@
## new version of shuffle() that allows for blocking
`shuffle` <- function(n, control = how()) {
- ## get blocking, if any
- Block <- getStrata(control, which = "blocks")
- if(is.null(Block))
- Block <- factor(rep(1, n))
+ ## get blocking, if any
+ Block <- getStrata(control, which = "blocks")
+ ## If no blocking, put all samples in same block
+ if(is.null(Block)) {
+ Block <- factor(rep(1, n))
+ } else {
+ ## There was blocking so update control to remove it
+ ## as we don't need it in control at the within-block
+ ## permutations performed in the loop
+ control <- update(control, blocks = NULL)
+ }
- sn <- seq_len(n) ## sequence of samples in order of input
+ 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
+ ## split sn on basis of Block
+ spln <- split(sn, Block)
+ nb <- length(spln) ## number of blocks
- ## result list
- out <- vector(mode = "list", length = nb)
+ ## 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
+ ## 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)
+ ## collect strata at Plot level
+ Pstrata <- getStrata(control, which = "plots", drop = TRUE)
+ plotCTRL <- getPlots(control)
- n <- length(ind)
- sn <- seq_len(n)
+ 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")
+ ## 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
+ ## 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)
}
- } else {
- start <- start.row <- start.col <- flip <- NULL
- }
- ## copy perm at this stage
- tmp <- perm
+ ## 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
- ## 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)]
- )
+ ## 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
}
- }
- perm <- tmp
}
- }
- ind[perm]
+ ind[perm]
}
More information about the Vegan-commits
mailing list