test_that("fwb() works", { eps <- if (capabilities("long.double")) 1e-8 else 1e-1 test_data <- readRDS(test_path("fixtures", "test_data.rds")) test_data$clus <- sample(1:50, nrow(test_data), replace = TRUE) boot_fun <- function(data, w = NULL) { fit <- glm(Y_B ~ A + X1 + X2 + X3 + X4, data = data, family = quasibinomial("probit"), weights = w) coef(fit) } set.seed(1234, "L") expect_no_condition({ f0 <- fwb(test_data, boot_fun, R = 100, verbose = FALSE) }) expect_identical(names(f0), c("t0", "t", "R", "data", "seed", "statistic", "call", "cluster", "strata", "wtype")) expect_equal(length(f0[["t0"]]), length(boot_fun(test_data))) expect_equal(ncol(f0[["t"]]), length(f0[["t0"]])) expect_equal(nrow(f0[["t"]]), f0[["R"]]) expect_equal(f0[["data"]], test_data) expect_equal(f0[["statistic"]], boot_fun) expect_null(f0[["cluster"]]) expect_null(f0[["strata"]]) expect_equal(f0[["wtype"]], "exp") expect_true(attr(f0, "simple", TRUE)) set.seed(1234, "L") expect_no_condition({ f1 <- fwb(test_data, boot_fun, R = 100, verbose = FALSE, simple = FALSE) }) expect_equal(f1[-7], f0[-7], tolerance = eps) expect_false(attr(f1, "simple", TRUE)) set.seed(1234, "L") expect_no_condition({ f2 <- fwb(test_data, function(data, w) c(boot_fun(data, w), w), R = 100, verbose = FALSE, cluster = clus) }) expect_identical(names(f2), c("t0", "t", "R", "data", "seed", "statistic", "call", "cluster", "strata", "wtype")) expect_equal(length(f2[["t0"]]), length(boot_fun(test_data)) + nrow(test_data)) expect_equal(ncol(f2[["t"]]), length(f2[["t0"]])) expect_equal(nrow(f2[["t"]]), f2[["R"]]) expect_equal(f2[["data"]], test_data) expect_failure(expect_null(f2[["cluster"]])) expect_null(f2[["strata"]]) expect_equal(f2[["wtype"]], "exp") expect_true(attr(f2, "simple", TRUE)) #Test that weights in each cluster are the same expect_true(all(apply(f2$t[,-(1:6)], 1, tapply, f2$cluster, function(z) all(z == z[1L])))) set.seed(1234, "L") expect_no_condition({ f3 <- fwb(test_data, boot_fun, R = 100, verbose = FALSE, wtype = "mammen") }) expect_failure(expect_equal(f0$t, f3$t, tolerance = eps, ignore_attr = TRUE)) }) test_that("parallel works", { skip_on_cran() eps <- if (capabilities("long.double")) 1e-8 else 1e-1 test_data <- readRDS(test_path("fixtures", "test_data.rds")) test_data$clus <- sample(1:50, nrow(test_data), replace = TRUE) boot_fun <- function(data, w = NULL) { fit <- glm(Y_B ~ A + X1 + X2 + X3 + X4, data = data, family = quasibinomial("probit"), weights = w) coef(fit) } set.seed(1234, "L") expect_no_condition({ f0 <- fwb(test_data, boot_fun, R = 100, verbose = FALSE) }) set.seed(1234, "L") expect_no_condition({ f1 <- fwb(test_data, boot_fun, R = 100, verbose = FALSE, cl = 2, simple = FALSE) }) expect_equal(f1[-7], f0[-7], tolerance = eps) expect_false(attr(f1, "simple", TRUE)) #Using cl = int set.seed(1234, "L") expect_no_condition({ f2 <- fwb(test_data, boot_fun, R = 100, verbose = FALSE, cl = 2, simple = TRUE) }) set.seed(1234, "L") expect_no_condition({ f3 <- fwb(test_data, boot_fun, R = 100, verbose = FALSE, cl = 2, simple = TRUE) }) expect_equal(f2, f3, tolerance = eps) #Using a cluster cl <- parallel::makeCluster(2) on.exit(parallel::stopCluster(cl)) parallel::clusterSetRNGStream(cl, 1234) expect_no_condition({ f2 <- fwb(test_data, boot_fun, R = 100, verbose = FALSE, cl = cl, simple = TRUE) }) parallel::clusterSetRNGStream(cl, 1234) expect_no_condition({ f3 <- fwb(test_data, boot_fun, R = 100, verbose = FALSE, cl = cl, simple = TRUE) }) expect_equal(f2, f3, tolerance = eps) }) test_that("wtype = 'multinom' replcates boot::boot()", { skip_on_cran() eps <- if (capabilities("long.double")) 1e-8 else 1e-1 test_data <- readRDS(test_path("fixtures", "test_data.rds")) set.seed(123, "L") clus <- sample(1:50, nrow(test_data), replace = TRUE) boot_fun <- function(data, w) { fit <- glm(Y_B ~ A + X1 + X2 + X3 + X4, data = data, family = quasibinomial("probit"), weights = w) coef(fit) } cl <- parallel::makeCluster(2) on.exit(parallel::stopCluster(cl)) expect_error({ f <- fwb(test_data, boot_fun, R = 10, verbose = FALSE, wtype = "multinom", simple = TRUE) }, "`simple` cannot be `TRUE`") #Without strata set.seed(1234, "L") expect_no_condition({ f <- fwb(test_data, boot_fun, R = 10, verbose = FALSE, wtype = "multinom") }) set.seed(1234, "L") expect_no_condition({ b <- boot::boot(test_data, boot_fun, R = 10, stype = "f") }) expect_equal(f$t, b$t, tolerance = eps, ignore_attr = TRUE) #With strata set.seed(1234, "L") expect_no_condition({ f <- fwb(test_data, boot_fun, R = 10, verbose = FALSE, wtype = "multinom", strata = A) }) set.seed(1234, "L") expect_no_condition({ b <- boot::boot(test_data, boot_fun, R = 10, stype = "f", strata = test_data$A) }) expect_equal(f$t, b$t, tolerance = eps, ignore_attr = TRUE) })