Adding unit tests for all crit fns (#2)

* Adding unit tests for all crit fns

* Fixing dep bug. Still need to consider the need for stat helper fns

DESCRIPTION

@@ -10,7 +10,7 @@ Description: A collection of criterion functions for statistical evidence genera
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.2
+RoxygenNote: 7.3.1
 Config/testthat/edition: 3
 Imports: 
  chef,
@@ -21,10 +21,10 @@ Imports:
  dplyr,
  knitr
 Suggests: 
- testthat (>= 3.0.0)
+ testthat (>= 3.0.0),
  pharmaverseadam
 Remotes:
- hta-pharma/chefStats
+ hta-pharma/chefStats,
  hta-pharma/chef
 VignetteBuilder: 
  knitr

R/crit_by_strata_by_trt.R

@@ -17,7 +17,7 @@
 crit_bb_nsubev_01 <- function(dat, event_index, subjectid_var, n_subj_event_min, ...){
 
  # Evaluate criterion
- crit_accept <- dat[J(event_index)] |>
+ crit_accept <- dat[list(event_index)] |>
  unique(by = c(subjectid_var)) |>
  nrow() >= n_subj_event_min
 

R/crit_endpoint.R

@@ -19,9 +19,9 @@ crit_ep_nsubev_01 <- function(dat,
  event_index,
  subjectid_var,
  treatment_var,
- n_subj_event_min = 10,
+ n_subj_event_min,
  ...) {
- stat <- dat[J(event_index)] |>
+ stat <- dat[list(event_index)] |>
  unique(by = c(subjectid_var, treatment_var))
 
  return(any(table(stat[[treatment_var]]) >= n_subj_event_min))

tests/testthat/helper-04-stats.R

@@ -15,6 +15,7 @@ n_sub <- function(dat,
 
  return(data.table(
  description = "Number of subjects",
+ qualifiers = NA_character_,
  label = "N",
  value = stat
  ))
@@ -35,6 +36,7 @@ n_subev <- function(dat,
 
  return(data.table(
  description = "Number of subjects with events",
+ qualifiers = NA_character_,
  label = "n",
  value = stat
  ))
@@ -58,6 +60,7 @@ p_subev <- function(dat,
 
  out <-
  data.table(description = "Proportion of subjects with events",
+ qualifiers = NA_character_,
  label = "(%)",
  value = n_subev / n_sub * 100)
 
@@ -101,6 +104,7 @@ summary_stats <- function(dat,
 
  return(data.table(
  description = "Summary statistics",
+ qualifiers = NA_character_,
  label = names(stat),
  value = as.list(stat)
  ))
@@ -126,12 +130,10 @@ n_subev_trt_diff <- function(dat,
  # In case stat is invalid, e.g. if obs. only exists in one treatment arm then replace stat with NA
  stat <- ifelse(length(stat) == 0, NA, stat)
 
- out <-
-
- data.table(description = "Absolute difference in number of subjects with events between treatment arms",
- label = "n_trt_diff",
- value = stat)
-
+ out <- data.table(description = "Absolute difference in number of subjects with events between treatment arms",
+ qualifiers = NA_character_,
+ label = "n_trt_diff",
+ value = stat)
 
  return(out)
 }
@@ -157,6 +159,7 @@ contingency2x2_ptest <- function(dat,
  # Prepare output
  out = data.table::data.table(
  description = "Fisher's exact test for count data",
+ qualifiers = NA_character_,
  label = c("Pval_independency", "CI_upper", "CI_lower"),
  value = c(res$p.value, res$conf.int[1], res$conf.int[2])
  )
@@ -189,6 +192,7 @@ contingency2x2_strata_test <- function(dat,
  # Prepare output
  out <- data.table::data.table(
  description = "Cochran-mante-haenszel test for odds ratios across strata",
+ qualifiers = NA_character_,
  label = c("Pval_independency", "CI_lower", "CI_upper"),
  value = c(res$p.value, res$conf.int[[1]], res$conf.int[[2]])
 

tests/testthat/test-crit_by_strata_by_trt.R

@@ -0,0 +1,76 @@
+test_that("Check crit_bb_nsubev_01", {
+ # SETUP -------------------------------------------------------------------
+
+ dat <- data.table(
+ INDEX_ = 1:10,
+ USUBJID = 1:10
+ )
+
+ setkey(dat, INDEX_)
+ event_index <- c(1, 3, 5, 7)
+ n_subj_event_min <- 5
+ subjectid_var <- "USUBJID"
+
+ # ACT ---------------------------------------------------------------------
+
+ crit_eval_1 <- crit_bb_nsubev_01(dat, event_index, subjectid_var, n_subj_event_min = 3)
+ crit_eval_2 <- crit_bb_nsubev_01(dat, event_index, subjectid_var, n_subj_event_min = 5)
+
+ # EXPECT ------------------------------------------------------------------
+
+ expect_true(crit_eval_1)
+ expect_false(crit_eval_2)
+ expect_error(crit_bb_nsubev_01(dat, event_index, subjectid_var))
+})
+
+test_that("Check crit_bb_pval_01", {
+ # SETUP -------------------------------------------------------------------
+
+ dat <- mk_adae()
+ dat[["INDEX_"]] <- 1:nrow(dat)
+ event_index <- c(1:10, 50:100, 600:700)
+ cell_index <- 500:700
+ treatment_var <- "TRT01A"
+ treatment_refval <- "Xanomeline High Dose"
+ subjectid_var <- "USUBJID"
+
+ pval_max_1 <- 0.87
+ pval_max_2 <- 0.88
+
+ # ACT ---------------------------------------------------------------------
+
+ crit_eval_1 <- crit_bb_pval_01(
+ dat = dat,
+ event_index = event_index,
+ cell_index = cell_index,
+ treatment_var = treatment_var,
+ treatment_refval = treatment_refval,
+ subjectid_var = subjectid_var,
+ pval_max = pval_max_1
+ )
+
+ crit_eval_2 <- crit_bb_pval_01(
+ dat = dat,
+ event_index = event_index,
+ cell_index = cell_index,
+ treatment_var = treatment_var,
+ treatment_refval = treatment_refval,
+ subjectid_var = subjectid_var,
+ pval_max = pval_max_2
+ )
+
+ # EXPECT ------------------------------------------------------------------
+
+ p_value <- chefStats::p_val(
+ dat = dat,
+ event_index = event_index,
+ cell_index = dat[["INDEX_"]],
+ treatment_var = treatment_var,
+ treatment_refval = treatment_refval,
+ subjectid_var = subjectid_var
+ )[["value"]]
+
+ expect_equal(crit_eval_1, p_value < pval_max_1)
+ expect_equal(crit_eval_2, p_value < pval_max_2)
+
+})

tests/testthat/test-crit_endpoint.R

@@ -0,0 +1,34 @@
+test_that("Check crit_ep_nsubev_01", {
+ # SETUP -------------------------------------------------------------------
+
+ dat <- mk_adae()
+ dat[["INDEX_"]] <- 1:nrow(dat)
+ setkey(dat, INDEX_)
+ event_index <- c(1:10, 50:100)
+ treatment_var <- "TRT01A"
+ treatment_refval <- "Xanomeline High Dose"
+ subjectid_var <- "USUBJID"
+
+ # ACT ---------------------------------------------------------------------
+
+ crit_eval_1 <- crit_ep_nsubev_01(
+ dat = dat,
+ event_index = event_index,
+ subjectid_var = subjectid_var,
+ treatment_var = treatment_var,
+ n_subj_event_min = 5
+ )
+ crit_eval_2 <- crit_ep_nsubev_01(
+ dat = dat,
+ event_index = event_index,
+ subjectid_var = subjectid_var,
+ treatment_var = treatment_var,
+ n_subj_event_min = 10
+ )
+
+ # EXPECT ------------------------------------------------------------------
+
+ expect_true(crit_eval_1)
+ expect_false(crit_eval_2)
+
+})