From 4928981b7b4430622cdbc131fb3d7d293a3bbcd9 Mon Sep 17 00:00:00 2001 From: nsjohnsen <99595467+nsjohnsen@users.noreply.github.com> Date: Mon, 11 Mar 2024 09:50:16 +0100 Subject: [PATCH] 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 | 6 +- R/crit_by_strata_by_trt.R | 2 +- R/crit_endpoint.R | 4 +- man/crit_ep_nsubev_01.Rd | 2 +- tests/testthat/helper-04-stats.R | 16 ++- tests/testthat/test-crit_by_strata_by_trt.R | 76 +++++++++++ tests/testthat/test-crit_endpoint.R | 34 +++++ tests/testthat/test-crit_socpt_01.R | 140 -------------------- 8 files changed, 127 insertions(+), 153 deletions(-) create mode 100644 tests/testthat/test-crit_by_strata_by_trt.R create mode 100644 tests/testthat/test-crit_endpoint.R delete mode 100644 tests/testthat/test-crit_socpt_01.R diff --git a/DESCRIPTION b/DESCRIPTION index 1c9c7c9..fb85cfb 100644 --- a/DESCRIPTION +++ b/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 diff --git a/R/crit_by_strata_by_trt.R b/R/crit_by_strata_by_trt.R index 9da4897..04c58bd 100644 --- a/R/crit_by_strata_by_trt.R +++ b/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 diff --git a/R/crit_endpoint.R b/R/crit_endpoint.R index e410ef1..19dd86d 100644 --- a/R/crit_endpoint.R +++ b/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)) diff --git a/man/crit_ep_nsubev_01.Rd b/man/crit_ep_nsubev_01.Rd index 6fe798d..38156d9 100644 --- a/man/crit_ep_nsubev_01.Rd +++ b/man/crit_ep_nsubev_01.Rd @@ -9,7 +9,7 @@ crit_ep_nsubev_01( event_index, subjectid_var, treatment_var, - n_subj_event_min = 10, + n_subj_event_min, ... ) } diff --git a/tests/testthat/helper-04-stats.R b/tests/testthat/helper-04-stats.R index 0492e31..866a372 100644 --- a/tests/testthat/helper-04-stats.R +++ b/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]]) diff --git a/tests/testthat/test-crit_by_strata_by_trt.R b/tests/testthat/test-crit_by_strata_by_trt.R new file mode 100644 index 0000000..431660c --- /dev/null +++ b/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) + +}) diff --git a/tests/testthat/test-crit_endpoint.R b/tests/testthat/test-crit_endpoint.R new file mode 100644 index 0000000..3cb1304 --- /dev/null +++ b/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) + +}) diff --git a/tests/testthat/test-crit_socpt_01.R b/tests/testthat/test-crit_socpt_01.R deleted file mode 100644 index 89b36b0..0000000 --- a/tests/testthat/test-crit_socpt_01.R +++ /dev/null @@ -1,140 +0,0 @@ -# NEEDS TO BE REVISED - -test_that("crit_ep_01 with nsub_min=10 (default)", -{ - # SETUP ------------------------------------------------------------------- - - skip_on_devops() - ep <- rbind( - ep_base( - data_prepare = mk_adae, - group_by = list(list(AESOC = c())), - endpoint_label = "", - crit_endpoint = list(c(crit_socpt_01)) - ) - ) - study_metadata <- list() - ep <- add_id(ep) - ep_fn_map <- suppressWarnings(unnest_endpoint_functions(ep)) - user_def_fn <- mk_userdef_fn_dt(ep_fn_map, env = environment()) - fn_map <- merge(ep_fn_map[, .(endpoint_spec_id, fn_hash)], user_def_fn, - by = "fn_hash") - adam_db <- - fetch_db_data(study_metadata = ep$study_metadata[[1]], - fn_dt = user_def_fn) - ep_and_data <- filter_db_data(ep, ep_fn_map, adam_db) - ep_data_key <- ep_and_data$ep - analysis_data_container <- ep_and_data$analysis_data_container - ep_expanded <- expand_over_endpoints(ep_data_key, analysis_data_container, fn_map) - ep_ev_index <- add_event_index(ep_expanded, analysis_data_container) - ep_with_data <- ep_ev_index[analysis_data_container] - - # ACT --------------------------------------------------------------------- - - ep_with_data[, crit_ep_accept := crit_socpt_01( - dat = dat[[1]], - endpoint_filter = endpoint_filter[[1]], - endpoint_group_metadata = endpoint_group_metadata[[1]], - event_index = event_index[[1]], - period_value = period_value[[1]], - period_var = period_var[[1]], - stratify_by = stratify_by[[1]], - treatment_refval = treatment_refval[[1]], - treatment_var = treatment_var, - subjectid_var = "USUBJID" - ), by = 1:nrow(ep_with_data)] - - # EXPECT ------------------------------------------------------------------ - - # Distribution of accepted vs. not accepted endpoints - expect_equal(nrow(ep_with_data), 22) - expect_equal(sum(ep_with_data$crit_ep_accept), 6) - expect_equal(sum(!ep_with_data$crit_ep_accept), 16) - - # SOCs that are accepted - expect_true(all(ep_with_data[ep_with_data$crit_ep_accept,][["endpoint_label"]] - %in% c( - "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS", - "GASTROINTESTINAL DISORDERS", - "SKIN AND SUBCUTANEOUS TISSUE DISORDERS", - "INFECTIONS AND INFESTATIONS", - "RESPIRATORY, THORACIC AND MEDIASTINAL DISORDERS", - "NERVOUS SYSTEM DISORDERS" - ))) -}) - -test_that("crit_ep_01 with nsub_min=5", -{ - # SETUP ------------------------------------------------------------------- - - skip_on_devops() - ep <- rbind( - ep_base( - data_prepare = mk_adae, - group_by = list(list(AESOC = c())), - endpoint_label = "", - crit_endpoint = list(c(crit_socpt_01, nsub_min = 5)) - ) - ) - study_metadata <- list() - ep <- add_id(ep) - ep_fn_map <- suppressWarnings(unnest_endpoint_functions(ep)) - user_def_fn <- mk_userdef_fn_dt(ep_fn_map, env = environment()) - fn_map <- merge(ep_fn_map[, .(endpoint_spec_id, fn_hash)], user_def_fn, - by = "fn_hash") - adam_db <- - fetch_db_data(study_metadata = ep$study_metadata[[1]], - fn_dt = user_def_fn) - ep_and_data <- filter_db_data(ep, ep_fn_map, adam_db) - ep_data_key <- ep_and_data$ep - analysis_data_container <- ep_and_data$analysis_data_container - ep_expanded <- expand_over_endpoints(ep_data_key, analysis_data_container, fn_map) - ep_ev_index <- add_event_index(ep_expanded, analysis_data_container) - ep_with_data <- ep_ev_index[analysis_data_container] - - # ACT --------------------------------------------------------------------- - - ep_with_data[, crit_ep_accept := crit_socpt_01( - dat = dat[[1]], - endpoint_filter = endpoint_filter[[1]], - endpoint_group_metadata = endpoint_group_metadata[[1]], - event_index = event_index[[1]], - period_value = period_value[[1]], - period_var = period_var[[1]], - stratify_by = stratify_by[[1]], - treatment_refval = treatment_refval[[1]], - treatment_var = treatment_var, - subjectid_var = "USUBJID", - nsub_min = 5 - ), by = 1:nrow(ep_with_data)] - - - # EXPECT ------------------------------------------------------------------ - - # Distribution of accepted vs. not accepted endpoints - expect_equal(nrow(ep_with_data), 22) - expect_equal(sum(ep_with_data$crit_ep_accept), 10) - expect_equal(sum(!ep_with_data$crit_ep_accept), 12) - - # SOCs that are accepted - expect_true(all( - ep_with_data[ep_with_data$crit_ep_accept,][["endpoint_label"]] - %in% c( - "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS", - "GASTROINTESTINAL DISORDERS", - "SKIN AND SUBCUTANEOUS TISSUE DISORDERS", - "INFECTIONS AND INFESTATIONS", - "RESPIRATORY, THORACIC AND MEDIASTINAL DISORDERS", - "NERVOUS SYSTEM DISORDERS", - "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS", - "GASTROINTESTINAL DISORDERS", - "INFECTIONS AND INFESTATIONS", - "CARDIAC DISORDERS", - "SKIN AND SUBCUTANEOUS TISSUE DISORDERS", - "RESPIRATORY, THORACIC AND MEDIASTINAL DISORDERS", - "MUSCULOSKELETAL AND CONNECTIVE TISSUE DISORDERS", - "PSYCHIATRIC DISORDERS", - "NERVOUS SYSTEM DISORDERS" , - "INVESTIGATIONS" - ))) -})