├── multiway_boot.R
└── multiway_boot_ex.R


/multiway_boot.R:
--------------------------------------------------------------------------------
 1 | library(plyr)
 2 | library(foreach)
 3 | 
 4 | r.double.or.nothing <- function(n) {
 5 |   2 * rbinom(n, 1, .5)
 6 | }
 7 | 
 8 | multiway.boot <- function(
 9 |   statistic, R,
10 |   groups = as.matrix(1:N),
11 |   verbose = FALSE,
12 |   RNG = r.double.or.nothing,
13 |   .parallel = FALSE,
14 |   .progress = 'none',
15 |   ...
16 |   ) {
17 |   groups <- apply(groups, 2, function(x) as.numeric(as.factor(x)))
18 |   N.groups <- apply(groups, 2, function(x) max(x))
19 |   N.groupingFactors <- ncol(groups)
20 | 
21 |   llply(
22 |     1:R,
23 |     function(r) {
24 |       # Observation weights are products of weights for each factor
25 |       w <- foreach(i = 1:N.groupingFactors, .combine = `*`) %do% {
26 |         RNG(N.groups[i])[groups[, i]]
27 |       }
28 | 
29 |       if (verbose) cat(i, " ")
30 |       statistic(..., weights = w)
31 |     },
32 |     .parallel = .parallel,
33 |     .progress = .progress
34 |     )
35 | }
36 | 


--------------------------------------------------------------------------------
/multiway_boot_ex.R:
--------------------------------------------------------------------------------
 1 | source("multiway_boot.R")
 2 | 
 3 | # In this example, we have two grouping factors, subjects and stimuli
 4 | 
 5 | # Generate simulated data
 6 | N <- 1e4
 7 | N.subjects <- 100
 8 | N.stimuli <- 20
 9 | 
10 | subjects.re <- rnorm(100)
11 | subject <- rep(1:100, each = 100)
12 | stimuli.re <- rlnorm(N.stimuli)
13 | stimulus <- sample.int(N.stimuli, N, replace = TRUE)
14 | 
15 | # x has subject, stimulus, and subject-stimulus (error) components
16 | x <- subjects.re[subject] + stimuli.re[stimulus] + rnorm(N)
17 | 
18 | # point estimate of mean
19 | mean(x)
20 | 
21 | library(Hmisc) # for wtd.mean
22 | 
23 | alpha <- .05
24 | q <- c(alpha / 2, 1 - alpha / 2)
25 | 
26 | # two-way bootstrap
27 | mb.2 <- multiway.boot(
28 |   statistic = wtd.mean,
29 |   R = 500,
30 |   groups = cbind(subject, stimulus),
31 |   .progress = 'text', # can use plyr progress indicators
32 |   x = x
33 |   )
34 | mb.2 <- unlist(mb.2)
35 | sd(mb.2) # bootstrap estimate of standard error of the mean
36 | qnorm(q, mean(x), sd(mb.2)) # normal approximation
37 | quantile(mb.2, q) # percentile bootstrap CI
38 | 
39 | # setup multicore for demonstration of parallel execution
40 | library(foreach)
41 | library(doMC)
42 | 
43 | registerDoMC()
44 | 
45 | # compare with (anti-conservative) one-way version
46 | mb.1 <- multiway.boot(
47 |   statistic = wtd.mean,
48 |   R = 500,
49 |   groups = cbind(subject), # only cluster/block on subject
50 |   .parallel = TRUE, # can use plyr parallel tools
51 |   x = x
52 |   )
53 | mb.1 <- unlist(mb.1)
54 | sd(mb.1)
55 | qnorm(q, mean(x), sd(mb.1))
56 | quantile(mb.1, q)
57 | 
58 | # compare with CI based on the normal, ignoring both grouping factors
59 | t.test(x, conf.level = 1 - alpha)$conf.int
60 | 


--------------------------------------------------------------------------------