V2.0 add stat.tbl continuous tests

R/add_stat.R

@@ -114,6 +114,11 @@ add_stat <- function(x, fns, location = everything() ~ "label") {
   check_not_missing(fns)
   check_class(x, c("tbl_summary", "tbl_svysummary", "tbl_continuous"))
 
+  # adding type if `tbl_continuous`...this is used later on
+  if (inherits(x, "tbl_continuous")) {
+    x$inputs$type <- rep_named(x$inputs$include, list("categorical"))
+  }
+
   # convert to named lists -----------------------------------------------------
   cards::process_formula_selectors(
     select_prep(x$table_body),
@@ -148,6 +153,8 @@ add_stat <- function(x, fns, location = everything() ~ "label") {
     dplyr::tibble(variable = names(fns)) |>
     dplyr::mutate(
       summary_type = map_chr(.data$variable, ~ x$inputs$type[[.x]]),
+      # tbl_continuous objects generally didn't have a "$inputs$type" object nested inside
+      # added it back to tbl_continuous
       row_type = map_chr(.data$variable, ~ location[[.x]]),
       label = map2(
         .data$variable, .data$row_type,

R/tbl_continuous.R

@@ -94,7 +94,6 @@ tbl_continuous <- function(data,
     digits = digits
   )
 
-
   # save processed function inputs ---------------------------------------------
   tbl_continuous_inputs <- as.list(environment())
   call <- match.call()

tests/testthat/test-add_stat.tbl_continuous.R

@@ -0,0 +1,57 @@
+test_that("add_stat() for 'tbl_continuous'", {
+  tt <-
+    trial |>
+    tbl_continuous(
+      age,
+      include = grade,
+      by = trt
+    )
+
+  add_stat_test1 <- function(data, variable, by, ...) {
+    tibble::tibble(addtl = "Data from elsewhere")
+  }
+
+  expect_equal(
+    tt |>
+      add_stat(fns = everything() ~ add_stat_test1) %>%
+      as_tibble() %>%
+      dplyr::pull(addtl),
+    c("Data from elsewhere", NA, NA, NA)
+  )
+})
+
+
+test_that("add_stat(location) for 'tbl_continuous'", {
+  tt <-
+    trial %>%
+    tbl_continuous(
+      age,
+      include = grade,
+      by = trt
+    )
+
+  p_vals <- lapply(
+    dplyr::group_split(trial, grade),
+    function(x) t.test(x$age ~ x$trt)$p.value
+  ) %>%
+    unlist %>%
+    round(3) %>%
+    as.character
+
+  add_stat_test2 <- function(data, variable, by, tbl, ...) {
+    col_name <- tbl$inputs$include
+    col_sym <- sym(col_name)
+
+    strat <- dplyr::group_split(data, !!col_sym)
+
+    lapply(strat, function(x) t.test(x$age ~ x$trt)$p.value) %>% unlist
+  }
+
+  expect_equal(
+    tt %>%
+      add_stat(fns = everything() ~ add_stat_test2, location = everything() ~ "level") %>%
+      as_tibble() %>%
+      dplyr::pull(add_stat_1),
+    c(NA, p_vals)
+  )
+})