From 091d5a1cdcaef1afe9c2b99dffe0360bbe23a957 Mon Sep 17 00:00:00 2001 From: Matthew Phelps Date: Wed, 17 Apr 2024 08:39:47 +0200 Subject: [PATCH] Add unit test to ensure changes to adam fn only invalidate targets that use those functions (#37) * Add unit test to ensure changes to adam fn only invalidate targets that use those functions * Fix rmd check and remove crew from used packags. This is because we have not enable parallel 'out-of-the-box'. Users can still enable parallel * Increment version number to 0.1.1 --- DESCRIPTION | 7 +- NEWS.md | 5 + R/fetch_db_data.R | 4 +- _pkgdown.yml | 18 ++ inst/templates/packages_template.R | 1 - pkgdown/extra.css | 8 + tests/testthat/test-targets.R | 360 +++++++++++++++++++---------- 7 files changed, 269 insertions(+), 134 deletions(-) create mode 100644 NEWS.md create mode 100644 pkgdown/extra.css diff --git a/DESCRIPTION b/DESCRIPTION index 9b792b9..4fd9775 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: chef Title: Framework for generating statistical evidence -Version: 0.1.0 +Version: 0.1.1 Authors@R: c( person("MEWP (Matthew David Phelps)", , , "mewp@novonordisk.com", role = "aut"), person("NOSJ (Nicolai Skov Johnsen)", , , "nosj@novonordisk.com", role = "aut"), @@ -28,7 +28,6 @@ Imports: usethis, purrr, stats, - crew Suggests: covr, fs, @@ -54,4 +53,6 @@ Config/testthat/edition: 3 Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.1 -URL: https://hta-pharma.github.io/chef/ +URL: + https://hta-pharma.github.io/chef/, + https://github.com/hta-pharma/chef diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 0000000..f15dafd --- /dev/null +++ b/NEWS.md @@ -0,0 +1,5 @@ +# chef 0.1.1 + +# chef 0.1.0 + +* Initial release. diff --git a/R/fetch_db_data.R b/R/fetch_db_data.R index 0ede50f..33fc213 100644 --- a/R/fetch_db_data.R +++ b/R/fetch_db_data.R @@ -31,8 +31,8 @@ fetch_db_data <- adam <- fn_dt[fn_type == "data_prepare"] adam[, c("dat", "error_flag", "error_msg") := eval_data_fn( - study_metadata = study_metadata, - fn = fn_callable + fn_list = fn_callable, + study_metadata = study_metadata ), by = seq_len(nrow(adam)) diff --git a/_pkgdown.yml b/_pkgdown.yml index d27a13f..36663e5 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -1,3 +1,21 @@ url: https://hta-pharma.github.io/chef/ template: bootstrap: 5 + bootswatch: flatly + +home: + links: + - text: HTA-R openstatsware workstream + href: https://www.openstatsware.org/hta_page.html + - text: ramnog + href: https://hta-pharma.github.io/ramnog/ + - text: chefStats + href: https://hta-pharma.github.io/chefStats/ + - text: chefCriteria + href: https://hta-pharma.github.io/chefCriteria + + +navbar: + structure: + left: [reference, news] + right: [github] diff --git a/inst/templates/packages_template.R b/inst/templates/packages_template.R index 3e5a97f..92f41ee 100644 --- a/inst/templates/packages_template.R +++ b/inst/templates/packages_template.R @@ -5,4 +5,3 @@ library(targets) library(tarchetypes) library(magrittr) library(data.table) -library(crew) diff --git a/pkgdown/extra.css b/pkgdown/extra.css new file mode 100644 index 0000000..0d925e7 --- /dev/null +++ b/pkgdown/extra.css @@ -0,0 +1,8 @@ +.dropdown-header { + font-size: 1.2rem; + color: #494646; + font-weight: 700; +} +.text-muted { + color: #8f9c9d !important; +} diff --git a/tests/testthat/test-targets.R b/tests/testthat/test-targets.R index 9e728a6..d7627f5 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() @@ -70,47 +68,48 @@ test_that("Base case: targets pipeline works", { }) -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() +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() @@ -138,10 +137,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)) ) } @@ -311,12 +308,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( @@ -352,6 +347,7 @@ test_that("Only affected branches outdated when new strata added", { x <- tar_meta() |> data.table::setDT() + # EXPECT ------------------------------------------------------------------ expect_outdated_patterns <- c( "study_data", @@ -381,98 +377,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_across_trt_", + "ep_stat_across_strata_across_trt_" + ) + # Take the time stamp of ep_fn_map, one of the early targets. + 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) { - x <- tar_meta() |> data.table::setDT() - expect_false(any(!is.na(x$error))) - }) + rgx <- paste0(i, collapse = "|") + compar_dt <- x[grepl(rgx, name), .(name, time)] + NROW(compar_dt[time < timestamp_re_run_target]) == 2 + }, FUN.VALUE = logical(1L)) + + # We expect a FALSE for study_data, as this target should NOT run + # before ep_fn_map + expect_equal(actual, c(FALSE, 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))) + }) + } +)