Add tests

R/boot_ci.R

@@ -51,11 +51,10 @@ boot_ci <- function(x,
   result <- list(
     N = NULL,
     estimate = NULL,
-    conf.low = NULL,
-    conf.high = NULL,
     conf.level = conf.level,
     R = R,
-    ci.type = type
+    conf.low = NULL,
+    conf.high = NULL
   )
 
   boot <- boot::boot(data = x, statistic = statistic, R = R, stype = stype)
@@ -67,10 +66,28 @@ boot_ci <- function(x,
       paste0("All values of t are equal to ", boot$t0, ". Cannot calculate confidence intervals."),
       call = get_cli_abort_call()
     )
+
   } else {
     boot.ci <- boot::boot.ci(boot, conf = conf.level, type = type)
-    result$conf.low <- boot.ci$percent[1, 4] |> unname()
-    result$conf.high <- boot.ci$percent[1, 5] |> unname()
+
+    if (type == "all") {
+      type_list <- c("normal", "basic", "percent", "bca")
+    } else {
+      type_list <- dplyr::case_match(
+        type,
+        "norm" ~ "normal",
+        "perc" ~ "percent",
+        .default = type
+      )
+    }
+
+    result$conf.low <- NULL
+    result$conf.high <- NULL
+    for (i in seq_along(type_list)) {
+      result[[paste0("ci.type.", i)]] <- type_list[i]
+      result[[paste0("conf.low.", i)]] <- rev(boot.ci[[type_list[i]]])[2] |> unname()
+      result[[paste0("conf.high.", i)]] <- rev(boot.ci[[type_list[i]]])[1] |> unname()
+    }
   }
 
   result

tests/testthat/_snaps/boot_ci.md

@@ -0,0 +1,81 @@
+# boot_ci() works with standard use
+
+    Code
+      res
+    Output
+      $N
+      [1] 254
+      
+      $estimate
+      [1] 75.08661
+      
+      $conf.level
+      [1] 0.95
+      
+      $R
+      [1] 2000
+      
+      $ci.type.1
+      [1] "percent"
+      
+      $conf.low.1
+      [1] 74.01998
+      
+      $conf.high.1
+      [1] 76.05906
+      
+
+---
+
+    Code
+      res
+    Message
+      {cards} data frame: 16 x 8
+    Output
+         variable   context   stat_name stat_label    stat   warning
+      1       AGE continuo…           N          N     254 bootstra…
+      2       AGE continuo…    estimate   estimate  75.087 bootstra…
+      3       AGE continuo…  conf.level  conf.lev…    0.95 bootstra…
+      4       AGE continuo…           R          R    2000 bootstra…
+      5       AGE continuo…   ci.type.1  ci.type.1  normal bootstra…
+      6       AGE continuo…  conf.low.1  conf.low…  74.074 bootstra…
+      7       AGE continuo… conf.high.1  conf.hig…  76.094 bootstra…
+      8       AGE continuo…   ci.type.2  ci.type.2   basic bootstra…
+      9       AGE continuo…  conf.low.2  conf.low…  74.091 bootstra…
+      10      AGE continuo… conf.high.2  conf.hig…  76.063 bootstra…
+      11      AGE continuo…   ci.type.3  ci.type.3 percent bootstra…
+      12      AGE continuo…  conf.low.3  conf.low…   74.11 bootstra…
+      13      AGE continuo… conf.high.3  conf.hig…  76.083 bootstra…
+      14      AGE continuo…   ci.type.4  ci.type.4     bca bootstra…
+      15      AGE continuo…  conf.low.4  conf.low…  74.076 bootstra…
+      16      AGE continuo… conf.high.4  conf.hig…  76.075 bootstra…
+    Message
+      i 2 more variables: fmt_fn, error
+
+# boot_ci() warnings work
+
+    Code
+      boot_ci(x[1], type = "perc")
+    Condition
+      Warning in `boot_ci()`:
+      All values of t are equal to 63. Cannot calculate confidence intervals.
+    Output
+      $N
+      [1] 1
+      
+      $estimate
+      [1] 63
+      
+      $conf.level
+      [1] 0.95
+      
+      $R
+      [1] 2000
+      
+      $conf.low
+      NULL
+      
+      $conf.high
+      NULL
+      
+

tests/testthat/test-boot_ci.R

@@ -0,0 +1,25 @@
+skip_if_not(do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "boot", reference_pkg = "cardx")))
+
+test_that("boot_ci() works with standard use", {
+  set.seed(1)
+  x <- cards::ADSL$AGE
+
+  res <- boot_ci(x, type = "perc")
+  expect_snapshot(res)
+
+  res <- cards::ADSL |>
+    cards::ard_continuous(
+      variables = AGE,
+      statistic = everything() ~ list(boot_ci = boot_ci)
+    )
+
+  expect_snapshot(res)
+})
+
+test_that("boot_ci() warnings work", {
+  x <- cards::ADSL$AGE
+
+  expect_snapshot(
+    boot_ci(x[1], type = "perc")
+  )
+})