From fccf4fb9a939464c732cbf0cb3f62cdfe366fedf Mon Sep 17 00:00:00 2001 From: Matthew Phelps Date: Tue, 16 Apr 2024 10:17:26 +0200 Subject: [PATCH] Add unit test to ensure changes to adam fn only invalidate targets that use those functions --- tests/testthat/test-targets.R | 378 ++++++++++++++++++++++------------ 1 file changed, 241 insertions(+), 137 deletions(-) diff --git a/tests/testthat/test-targets.R b/tests/testthat/test-targets.R index 548a5d8..4ba0ff3 100644 --- a/tests/testthat/test-targets.R +++ b/tests/testthat/test-targets.R @@ -52,11 +52,9 @@ test_that("Base case: targets pipeline works", { dump("n_subev", file = "R/custom_functions.R") dump("n_subev_trt_diff", file = "R/custom_functions.R", append = TRUE) dump("contingency2x2_strata_test", - file = "R/custom_functions.R", - append = TRUE - ) + file = "R/custom_functions.R", + append = TRUE) # ACT --------------------------------------------------------------------- - tar_make() # EXPECT ------------------------------------------------------------------ x <- tar_meta() %>% as.data.table() @@ -67,56 +65,57 @@ test_that("Base case: targets pipeline works", { expect_snapshot(ep_stat$stat_result_value) }) -test_that("targets pipeline works no criteria fn and missing by_* functions", { - # SETUP ------------------------------------------------------------------- - testr::create_local_project() - - mk_ep_def <- function() { - ep <- mk_endpoint_str( - study_metadata = list(), - pop_var = "SAFFL", - pop_value = "Y", - treatment_var = "TRT01A", - treatment_refval = "Xanomeline High Dose", - period_var = "ANL01FL", - period_value = "Y", - stratify_by = list(c("SEX")), - data_prepare = mk_adcm, - endpoint_label = "A", - custom_pop_filter = "TRT01A %in% c('Placebo', 'Xanomeline High Dose')", - group_by = list(list(RACE = c())), - stat_by_strata_by_trt = list("n_subev" = c(n_subev)) - ) - } - - # This is needed because mk_adcm it is calling from a new R session, it - # doesn't have access to the helper-* functions from chef - n_subev <- n_subev - n_subev_trt_diff <- n_subev_trt_diff - contingency2x2_ptest <- contingency2x2_ptest - - use_chef( - pipeline_dir = "pipeline", - r_functions_dir = "R/", - pipeline_id = "01", - mk_endpoint_def_fn = mk_ep_def, - mk_adam_fn = list(mk_adcm) - ) - dump("n_subev", file = "R/custom_functions.R") - dump("n_subev_trt_diff", file = "R/custom_functions.R", append = TRUE) - dump("contingency2x2_ptest", file = "R/custom_functions.R", append = TRUE) - - # ACT --------------------------------------------------------------------- - tar_make() - - # EXPECT ------------------------------------------------------------------ - x <- tar_meta() %>% as.data.table() - expect_true(all(is.na(x$error))) - tar_load(ep_stat) - expect_equal(NROW(ep_stat), 18) - expect_equal(NCOL(ep_stat), 37) - expect_snapshot(ep_stat$stat_result_value) -}) +test_that("targets pipeline works no criteria fn and missing by_* functions", + { + # SETUP ------------------------------------------------------------------- + testr::create_local_project() + + mk_ep_def <- function() { + ep <- mk_endpoint_str( + study_metadata = list(), + pop_var = "SAFFL", + pop_value = "Y", + treatment_var = "TRT01A", + treatment_refval = "Xanomeline High Dose", + period_var = "ANL01FL", + period_value = "Y", + stratify_by = list(c("SEX")), + data_prepare = mk_adcm, + endpoint_label = "A", + custom_pop_filter = "TRT01A %in% c('Placebo', 'Xanomeline High Dose')", + group_by = list(list(RACE = c())), + stat_by_strata_by_trt = list("n_subev" = c(n_subev)) + ) + } + + # This is needed because mk_adcm it is calling from a new R session, it + # doesn't have access to the helper-* functions from chef + n_subev <- n_subev + n_subev_trt_diff <- n_subev_trt_diff + contingency2x2_ptest <- contingency2x2_ptest + + use_chef( + pipeline_dir = "pipeline", + r_functions_dir = "R/", + pipeline_id = "01", + mk_endpoint_def_fn = mk_ep_def, + mk_adam_fn = list(mk_adcm) + ) + dump("n_subev", file = "R/custom_functions.R") + dump("n_subev_trt_diff", file = "R/custom_functions.R", append = TRUE) + dump("contingency2x2_ptest", file = "R/custom_functions.R", append = TRUE) + + # ACT --------------------------------------------------------------------- + tar_make() + + # EXPECT ------------------------------------------------------------------ + x <- tar_meta() %>% as.data.table() + expect_true(all(is.na(x$error))) + tar_load(ep_stat) + expect_equal(NROW(ep_stat), 18) + expect_equal(NCOL(ep_stat), 37) + expect_snapshot(ep_stat$stat_result_value) + }) test_that("branching after prepare for stats step works", { # SETUP ------------------------------------------------------------------- @@ -132,10 +131,8 @@ test_that("branching after prepare for stats step works", { stratify_by = list(c("SEX")), data_prepare = mk_adae, custom_pop_filter = "TRT01A %in% c('Placebo', 'Xanomeline High Dose')", - stat_by_strata_by_trt = list( - "fn_1" = c(n_subev), - "fn_2" = c(n_sub) - ) + stat_by_strata_by_trt = list("fn_1" = c(n_subev), + "fn_2" = c(n_sub)) ) } @@ -302,12 +299,10 @@ test_that("Only affected branches outdated when new strata added", { x <- whisker::whisker.render(tmp, data = list(r_script_dir = "R/")) - writeLines(whisker::whisker.render(tmp, data = list( - r_script_dir = - "R/" - )), con = "_targets.R") + writeLines(whisker::whisker.render(tmp, data = list(r_script_dir = + "R/")), con = "_targets.R") tar_make() - + # ACT --------------------------------------------------------------------- mk_endpoint_def <- function() { list( mk_endpoint_str( @@ -343,6 +338,7 @@ test_that("Only affected branches outdated when new strata added", { x <- tar_meta() |> data.table::setDT() + # EXPECT ------------------------------------------------------------------ expect_outdated_patterns <- c( "study_data", @@ -372,98 +368,206 @@ test_that("Only affected branches outdated when new strata added", { }) -test_that("Check for discordant columns in result data model when having one endpoint spec without grouping and one endpoint spec with grouping", { +test_that("Only affected branches outdated when mk_adam are updated", { # SETUP ------------------------------------------------------------------- mk_endpoint_def <- function() { - ep <- mk_endpoint_str( - study_metadata = list(), - pop_var = "SAFFL", - pop_value = "Y", - treatment_var = "TRT01A", - treatment_refval = "Xanomeline High Dose", - stratify_by = list(c("SEX", "AGEGR1")), - data_prepare = mk_adae, - endpoint_label = "A", - custom_pop_filter = - "TRT01A %in% c('Placebo', 'Xanomeline High Dose')", - group_by = list(list( - AESOC = c(), AESEV = c() - )), - stat_by_strata_by_trt = list(c(n_sub)) - ) - - ep2 <- mk_endpoint_str( - data_prepare = mk_advs, - treatment_var = "TRT01A", - treatment_refval = "Xanomeline High Dose", - pop_var = "SAFFL", - pop_value = "Y", - stratify_by = list(c("AGEGR1", "SEX")), - stat_by_strata_by_trt = list(c(n_sub)), - endpoint_label = "Demographics endpoint (categorical measures)" - ) - - data.table::rbindlist(list(ep, ep2)) - } - - mk_advs <- function(study_metadata) { - # Read ADSL - adsl <- data.table::as.data.table(pharmaverseadam::adsl) - - # Filter treatment arms - adsl <- adsl[adsl$TRT01A %in% c("Placebo", "Xanomeline High Dose")] - adsl[1, AGEGR1 := NA_character_] - adsl[2:10, SEX := NA_character_] - - # Read ADVS - advs <- data.table::as.data.table(pharmaverseadam::advs) - - # Identify baseline body weight - advs_bw <- advs[advs$PARAMCD == "WEIGHT" & advs$VISIT == "BASELINE"] - - # Create new variable BW_BASELINE - advs_bw[["BW_BASELINE"]] <- advs_bw[["AVAL"]] - - # Merge ADSL, ADAE and baseline body weight from ADVS - adam_out <- - merge(adsl, advs_bw[, c("BW_BASELINE", "USUBJID")], by = "USUBJID", all.x = TRUE) - - return(adam_out) + list( + mk_endpoint_str( + study_metadata = list(), + pop_var = "SAFFL", + pop_value = "Y", + treatment_var = "TRT01A", + treatment_refval = "Xanomeline High Dose", + stratify_by = list(c("SEX")), + group_by = list(list(AESEV = c())), + data_prepare = mk_adae, + custom_pop_filter = "TRT01A %in% c('Placebo', 'Xanomeline High Dose')", + stat_by_strata_by_trt = list( + "fn_1" = c(n_sub), + "fn_2_adae" = c(p_subev) + ) + ), + mk_endpoint_str( + study_metadata = list(), + pop_var = "SAFFL", + pop_value = "Y", + treatment_var = "TRT01A", + treatment_refval = "Xanomeline High Dose", + stratify_by = list(c("SEX")), + data_prepare = mk_adcm, + custom_pop_filter = "TRT01A %in% c('Placebo', 'Xanomeline High Dose')", + stat_by_strata_by_trt = list("fn_2_adcm" = c(n_sub)) + ) + ) |> data.table::rbindlist() } # This is needed because mk_adcm it is calling from a new R session, it # doesn't have access to the helper-* functions from chef path <- - system.file("templates", package = "chef") |> - file.path("template-pipeline.R") + system.file("templates", package = "chef") |> file.path("template-pipeline.R") tmp <- readLines(path) - - # ACT --------------------------------------------------------------------- - tar_dir({ dir.create("R") - dump("n_sub", file = "R/custom_functions.R") + dump("p_subev", file = "R/custom_functions.R") + dump("n_sub", file = "R/custom_functions.R", append = TRUE) dump("mk_adae", file = "R/mk_adae.R") - dump("mk_advs", file = "R/mk_advs.R") + dump("mk_adcm", file = "R/mk_adcm.R") dump("mk_endpoint_def", file = "R/mk_endpoint_def.R") - x <- whisker::whisker.render(tmp, data = list(r_script_dir = "R/")) - writeLines(whisker::whisker.render(tmp, data = list( - r_script_dir = "R/" - )), con = "_targets.R") + x <- + whisker::whisker.render(tmp, data = list(r_script_dir = "R/")) + writeLines(whisker::whisker.render(tmp, data = list(r_script_dir = + "R/")), con = "_targets.R") + tar_make() + # ACT --------------------------------------------------------------------- + mk_adae <- function(study_metadata) { + adsl <- data.table::as.data.table(pharmaverseadam::adsl) + adsl[, AGEGR2 := data.table::fcase( + AGE < 65, "AGE < 65", + AGE >= 65, "AGE >= 65" + )] + + adae <- data.table::as.data.table(pharmaverseadam::adae) + + adae_out <- + merge(adsl, adae[, c(setdiff(names(adae), names(adsl)), "USUBJID"), + with = + F + ], by = "USUBJID", all = TRUE) + adae_out[] + } + dump("mk_adae", file = "R/mk_adae.R") tar_make() + x <- tar_meta() |> data.table::setDT() + # EXPECT ------------------------------------------------------------------ + expect_outdated_patterns <- + c( + "study_data", + "ep_prep_by_strata_by_trt_", + "ep_stat_by_strata_by_trt_", + "ep_crit_by_strata_by_trt_", + "ep_crit_endpoint_" + ) + timestamp_re_run_target <- + x[grepl("ep_fn_map", name), time][2] - targets::tar_load(ep_stat) - expect_equal(nrow(ep_stat), 700) - expect_equal(ncol(ep_stat), 37) - expect_equal(sum(ep_stat$endpoint_spec_id == 1), 690) - expect_equal(sum(ep_stat$endpoint_spec_id == 2), 10) + # Check that the targets we expected to be skipped were actually + # skipped + actual <- + vapply(expect_outdated_patterns, function(i) { + rgx <- paste0(i, collapse = "|") + compar_dt <- x[grepl(rgx, name), .(name, time)] + NROW(compar_dt[time < timestamp_re_run_target]) == 1 + }, FUN.VALUE = logical(1L)) - x <- tar_meta() |> data.table::setDT() - expect_false(any(!is.na(x$error))) - }) + + # We expect a FALSE for study_data, as this target should NOT run + # before ep_fn_map + expect_equal(actual, c(FALSE, TRUE, TRUE, TRUE, TRUE), ignore_attr = TRUE) + + }) }) + +test_that( + "Check for discordant columns in result data model when having one endpoint spec without grouping and one endpoint spec with grouping", + { + # SETUP ------------------------------------------------------------------- + mk_endpoint_def <- function() { + ep <- mk_endpoint_str( + study_metadata = list(), + pop_var = "SAFFL", + pop_value = "Y", + treatment_var = "TRT01A", + treatment_refval = "Xanomeline High Dose", + stratify_by = list(c("SEX", "AGEGR1")), + data_prepare = mk_adae, + endpoint_label = "A", + custom_pop_filter = + "TRT01A %in% c('Placebo', 'Xanomeline High Dose')", + group_by = list(list( + AESOC = c(), AESEV = c() + )), + stat_by_strata_by_trt = list(c(n_sub)) + ) + + ep2 <- mk_endpoint_str( + data_prepare = mk_advs, + treatment_var = "TRT01A", + treatment_refval = "Xanomeline High Dose", + pop_var = "SAFFL", + pop_value = "Y", + stratify_by = list(c("AGEGR1", "SEX")), + stat_by_strata_by_trt = list(c(n_sub)), + endpoint_label = "Demographics endpoint (categorical measures)" + ) + + data.table::rbindlist(list(ep, ep2)) + } + + mk_advs <- function(study_metadata) { + # Read ADSL + adsl <- data.table::as.data.table(pharmaverseadam::adsl) + + # Filter treatment arms + adsl <- + adsl[adsl$TRT01A %in% c("Placebo", "Xanomeline High Dose")] + adsl[1, AGEGR1 := NA_character_] + adsl[2:10, SEX := NA_character_] + + # Read ADVS + advs <- data.table::as.data.table(pharmaverseadam::advs) + + # Identify baseline body weight + advs_bw <- + advs[advs$PARAMCD == "WEIGHT" & advs$VISIT == "BASELINE"] + + # Create new variable BW_BASELINE + advs_bw[["BW_BASELINE"]] <- advs_bw[["AVAL"]] + + # Merge ADSL, ADAE and baseline body weight from ADVS + adam_out <- + merge(adsl, advs_bw[, c("BW_BASELINE", "USUBJID")], by = "USUBJID", all.x = TRUE) + + return(adam_out) + } + + # This is needed because mk_adcm it is calling from a new R session, it + # doesn't have access to the helper-* functions from chef + path <- + system.file("templates", package = "chef") |> + file.path("template-pipeline.R") + tmp <- readLines(path) + + # ACT --------------------------------------------------------------------- + + tar_dir({ + dir.create("R") + dump("n_sub", file = "R/custom_functions.R") + dump("mk_adae", file = "R/mk_adae.R") + dump("mk_advs", file = "R/mk_advs.R") + dump("mk_endpoint_def", file = "R/mk_endpoint_def.R") + + x <- + whisker::whisker.render(tmp, data = list(r_script_dir = "R/")) + writeLines(whisker::whisker.render(tmp, data = list(r_script_dir = "R/")), con = "_targets.R") + + tar_make() + + # EXPECT ------------------------------------------------------------------ + + + targets::tar_load(ep_stat) + expect_equal(nrow(ep_stat), 700) + expect_equal(ncol(ep_stat), 37) + expect_equal(sum(ep_stat$endpoint_spec_id == 1), 690) + expect_equal(sum(ep_stat$endpoint_spec_id == 2), 10) + + x <- tar_meta() |> data.table::setDT() + expect_false(any(!is.na(x$error))) + }) + } +)