tests/testthat/test-boot.R

In fwb: Fractional Weighted Bootstrap

test_that("fwb aligns with boot", {
  skip_if_not_installed("boot")

  eps <- if (capabilities("long.double")) 1e-8 else 1e-1

  test_data <- readRDS(test_path("fixtures", "test_data.rds"))

  set.seed(12345, "L")
  test_data <- test_data[sample.int(nrow(test_data), 500),]

  set_fwb_wtype("multinom")
  on.exit(set_fwb_wtype("exp"))

  boot_fun <- function(data, w = NULL) {
    fit <- glm(Y_B ~ A + X1 + X2 + X3 + X4, data = data,
               family = quasibinomial("logit"), weights = w)
    coef(fit)
  }

  set.seed(1234, "L")
  expect_no_condition({
    f0 <- fwb(test_data, boot_fun, R = 550, verbose = FALSE)
  })

  set.seed(1234, "L")
  expect_no_condition({
    b0 <- boot::boot(test_data, boot_fun, R = 550, stype = "f")
  })

  expect_equal(f0[["t"]], b0[["t"]],
               tolerance = eps, ignore_attr = TRUE)

  expect_equal(f0[["t0"]], b0[["t0"]],
               tolerance = eps, ignore_attr = TRUE)

  ci.types <- c("norm", "basic", "perc", "bca")

  expect_no_condition({
    f0.ci <- fwb.ci(f0, conf = .86, type = ci.types, index = 3)
  })

  expect_no_condition({
    b0.ci <- boot::boot.ci(b0, conf = .86, type = ci.types, index = 3)
  })

  expect_equal(f0.ci[-3], b0.ci[-3],
               tolerance = eps, ignore_attr = TRUE)

  expect_equal(get_ci(f0.ci), get_ci(b0.ci),
               tolerance = eps)

  # Test with hinv
  expect_no_condition({
    f0.ci <- fwb.ci(f0, conf = .86, type = ci.types, index = 3,
                    hinv = exp)
  })

  expect_no_condition({
    b0.ci <- boot::boot.ci(b0, conf = .86, type = ci.types, index = 3,
                           hinv = exp)
  })

  expect_equal(f0.ci[-3], b0.ci[-3],
               tolerance = eps, ignore_attr = TRUE)

  expect_equal(get_ci(f0.ci), get_ci(b0.ci),
               tolerance = eps)


  # Extreme endpoints
  for (i in c("basic", "perc", "bca")) {
    expect_warning({
      f0.ci <- fwb.ci(f0, conf = .999, type = i, index = 4)
    }, .w("xtreme order statistics used as endpoints"))

    expect_warning({
      b0.ci <- boot::boot.ci(b0, conf = .999, type = i, index = 4)
    }, .w("xtreme order statistics used as endpoints"))

    expect_equal(f0.ci[-3], b0.ci[-3],
                 tolerance = eps, ignore_attr = TRUE)

    expect_equal(get_ci(f0.ci), get_ci(b0.ci),
                 tolerance = eps, ignore_attr = TRUE)
  }

})