From a9aa5664926075d2c131159c4815c30bd3e3e840 Mon Sep 17 00:00:00 2001 From: Stefan Bundfuss <80953585+bundfussr@users.noreply.github.com> Date: Wed, 11 Oct 2023 15:34:23 +0200 Subject: [PATCH] Closes #2154 fix_dthcaus: fix derive_var_dthcaus() (#2162) * #2154 fix_dthcaus: fix derive_var_dthcaus() * #2154 fix_dthcaus: run templates check * #2154 fix_dthcaus: update version number and NEWS --- .github/workflows/templates.yml | 2 +- DESCRIPTION | 2 +- NEWS.md | 7 ++ R/derive_var_dthcaus.R | 4 +- tests/testthat/test-derive_var_dthcaus.R | 118 ++++++++++++++++++++++- 5 files changed, 126 insertions(+), 7 deletions(-) diff --git a/.github/workflows/templates.yml b/.github/workflows/templates.yml index c693311d52..58d8cbc9f6 100644 --- a/.github/workflows/templates.yml +++ b/.github/workflows/templates.yml @@ -6,7 +6,7 @@ on: pull_request: branches: - main - - devel + - patch jobs: templates: diff --git a/DESCRIPTION b/DESCRIPTION index 8776814cca..e2f46de44e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: admiral Type: Package Title: ADaM in R Asset Library -Version: 0.12.2 +Version: 0.12.3 Authors@R: c( person("Ben", "Straub", email = "ben.x.straub@gsk.com", role = c("aut", "cre")), person("Stefan", "Bundfuss", role = "aut"), diff --git a/NEWS.md b/NEWS.md index 8da921cb28..63d4ea4a5b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,10 @@ +# admiral 0.12.3 + +- Fixed a bug in `derive_var_dthcaus()` where if a subject has observations in +more than one of the sources, the one from the last source was selected +regardless of the date. Now the function works as described in its +documentation. (#2154) + # admiral 0.12.2 - A unit test for `derive_param_computed()` was modified in anticipation of major user-facing changes to R version 4.4 (#2147) diff --git a/R/derive_var_dthcaus.R b/R/derive_var_dthcaus.R index c03c5366d5..ed9c74f37c 100644 --- a/R/derive_var_dthcaus.R +++ b/R/derive_var_dthcaus.R @@ -161,6 +161,8 @@ derive_var_dthcaus <- function(dataset, # process each source add_data <- vector("list", length(sources)) + tmp_source_nr <- get_new_tmp_var(dataset) + tmp_date <- get_new_tmp_var(dataset) for (ii in seq_along(sources)) { source_dataset_name <- sources[[ii]]$dataset_name source_dataset <- source_datasets[[source_dataset_name]] @@ -184,8 +186,6 @@ derive_var_dthcaus <- function(dataset, ) # if several death records, use the first/last according to 'mode' - tmp_source_nr <- get_new_tmp_var(dataset) - tmp_date <- get_new_tmp_var(dataset) add_data[[ii]] <- add_data[[ii]] %>% filter_extreme( order = exprs(!!date_var, !!!sources[[ii]]$order), diff --git a/tests/testthat/test-derive_var_dthcaus.R b/tests/testthat/test-derive_var_dthcaus.R index 387564b0bf..32d811c593 100644 --- a/tests/testthat/test-derive_var_dthcaus.R +++ b/tests/testthat/test-derive_var_dthcaus.R @@ -341,7 +341,7 @@ test_that("derive_var_dthcaus Test 6: DTHCAUS is added from AE and DS if filter }) ## Test 7: error on a dthcaus_source object with invalid order ---- -test_that("dthcaus_source Test 7: error on a dthcaus_source object with invalid order", { +test_that("derive_var_dthcaus Test 7: error on a dthcaus_source object with invalid order", { expect_error(dthcaus_source( dataset_name = "ae", filter = AEOUT == "FATAL", @@ -352,7 +352,7 @@ test_that("dthcaus_source Test 7: error on a dthcaus_source object with invalid )) }) -## Test 8: dataset` is sorted using the `order` parameter ---- +## Test 8: `dataset` is sorted using the `order` parameter ---- test_that("derive_var_dthcaus Test 8: `dataset` is sorted using the `order` parameter", { adsl <- tibble::tribble( ~STUDYID, ~USUBJID, @@ -415,7 +415,7 @@ test_that("derive_var_dthcaus Test 8: `dataset` is sorted using the `order` para }) ## Test 9: returns a warning when traceability_vars is used ---- -test_that("dthcaus_source Test 9: returns a warning when traceability_vars is used", { +test_that("derive_var_dthcaus Test 9: returns a warning when traceability_vars is used", { ae <- tibble::tribble( ~STUDYID, ~USUBJID, ~AESEQ, ~AEDECOD, ~AEOUT, ~AEDTHDTC, "TEST01", "PAT01", 12, "SUDDEN DEATH", "FATAL", "2021-04-04" @@ -437,3 +437,115 @@ test_that("dthcaus_source Test 9: returns a warning when traceability_vars is us class = "lifecycle_warning_deprecated" ) }) + +## Test 10: multiple observations from different sources ---- +test_that("derive_var_dthcaus Test 10: multiple observations from different sources", { + expected <- tibble::tribble( + ~STUDYID, ~USUBJID, ~DTHCAUS, + "TEST01", "PAT01", "SUDDEN DEATH", + "TEST01", "PAT02", NA_character_, + "TEST01", "PAT03", "DEATH DUE TO progression of disease" + ) + + adsl <- select(expected, -DTHCAUS) + + ae <- tibble::tribble( + ~STUDYID, ~USUBJID, ~AESEQ, ~AEDECOD, ~AEOUT, ~AEDTHDTC, + "TEST01", "PAT01", 12, "SUDDEN DEATH", "FATAL", "2021-04-04" + ) %>% + mutate( + AEDTHDT = ymd(AEDTHDTC) + ) + + ds <- tibble::tribble( + ~STUDYID, ~USUBJID, ~DSSEQ, ~DSDECOD, ~DSTERM, ~DSSTDTC, + "TEST01", "PAT01", 4, "DEATH", "DEATH DUE TO progression of disease", "2021-04-05", + "TEST01", "PAT02", 1, "INFORMED CONSENT OBTAINED", "INFORMED CONSENT OBTAINED", "2021-04-02", + "TEST01", "PAT02", 2, "RANDOMIZATION", "RANDOMIZATION", "2021-04-11", + "TEST01", "PAT02", 3, "COMPLETED", "PROTOCOL COMPLETED", "2021-12-01", + "TEST01", "PAT03", 1, "DEATH", "DEATH DUE TO progression of disease", "2021-04-07", + "TEST01", "PAT03", 2, "RANDOMIZATION", "RANDOMIZATION", "2021-04-11", + "TEST01", "PAT03", 3, "COMPLETED", "PROTOCOL COMPLETED", "2021-12-01" + ) + + # Derive `DTHCAUS` only - for on-study deaths only + src_ae <- dthcaus_source( + dataset_name = "ae", + filter = AEOUT == "FATAL", + date = convert_dtc_to_dt(AEDTHDTC), + mode = "first", + dthcaus = AEDECOD + ) + + src_ds <- dthcaus_source( + dataset_name = "ds", + filter = DSDECOD == "DEATH" & grepl("DEATH DUE TO", DSTERM), + date = convert_dtc_to_dt(DSSTDTC), + mode = "first", + dthcaus = DSTERM + ) + actual <- adsl %>% + derive_var_dthcaus(src_ae, src_ds, source_datasets = list(ae = ae, ds = ds)) + + expect_dfs_equal( + base = expected, + compare = actual, + keys = c("USUBJID") + ) +}) + +## Test 11: multiple observations from different sources with same date ---- +test_that("derive_var_dthcaus Test 11: multiple observations with same date", { + expected <- tibble::tribble( + ~STUDYID, ~USUBJID, ~DTHCAUS, + "TEST01", "PAT01", "SUDDEN DEATH", + "TEST01", "PAT02", NA_character_, + "TEST01", "PAT03", "DEATH DUE TO progression of disease" + ) + + adsl <- select(expected, -DTHCAUS) + + ae <- tibble::tribble( + ~STUDYID, ~USUBJID, ~AESEQ, ~AEDECOD, ~AEOUT, ~AEDTHDTC, + "TEST01", "PAT01", 12, "SUDDEN DEATH", "FATAL", "2021-04-05" + ) %>% + mutate( + AEDTHDT = ymd(AEDTHDTC) + ) + + ds <- tibble::tribble( + ~STUDYID, ~USUBJID, ~DSSEQ, ~DSDECOD, ~DSTERM, ~DSSTDTC, + "TEST01", "PAT01", 4, "DEATH", "DEATH DUE TO progression of disease", "2021-04-05", + "TEST01", "PAT02", 1, "INFORMED CONSENT OBTAINED", "INFORMED CONSENT OBTAINED", "2021-04-02", + "TEST01", "PAT02", 2, "RANDOMIZATION", "RANDOMIZATION", "2021-04-11", + "TEST01", "PAT02", 3, "COMPLETED", "PROTOCOL COMPLETED", "2021-12-01", + "TEST01", "PAT03", 1, "DEATH", "DEATH DUE TO progression of disease", "2021-04-07", + "TEST01", "PAT03", 2, "RANDOMIZATION", "RANDOMIZATION", "2021-04-11", + "TEST01", "PAT03", 3, "COMPLETED", "PROTOCOL COMPLETED", "2021-12-01" + ) + + # Derive `DTHCAUS` only - for on-study deaths only + src_ae <- dthcaus_source( + dataset_name = "ae", + filter = AEOUT == "FATAL", + date = convert_dtc_to_dt(AEDTHDTC), + mode = "first", + dthcaus = AEDECOD + ) + + src_ds <- dthcaus_source( + dataset_name = "ds", + filter = DSDECOD == "DEATH" & grepl("DEATH DUE TO", DSTERM), + date = convert_dtc_to_dt(DSSTDTC), + mode = "first", + dthcaus = DSTERM + ) + actual <- adsl %>% + derive_var_dthcaus(src_ae, src_ds, source_datasets = list(ae = ae, ds = ds)) + + expect_dfs_equal( + base = expected, + compare = actual, + keys = c("USUBJID") + ) +})