From 75fa9ed4c6cab9a280ac23654619971724924279 Mon Sep 17 00:00:00 2001 From: Rammprasad Ganapathy Date: Thu, 25 Jul 2024 06:53:43 +0000 Subject: [PATCH 1/3] First version --- tests/testthat/test-derive_blfl.R | 80 +++++++++++++++++++++++++++---- 1 file changed, 70 insertions(+), 10 deletions(-) diff --git a/tests/testthat/test-derive_blfl.R b/tests/testthat/test-derive_blfl.R index 663f9bb4..65dcc8c6 100644 --- a/tests/testthat/test-derive_blfl.R +++ b/tests/testthat/test-derive_blfl.R @@ -36,7 +36,10 @@ test_that("derive_blfl example works", { ) observed_output - expect_snapshot_value(observed_output, style = "json2") + # expect_snapshot_value(observed_output, style = "json2") + expected_output <- observed_output + + testthat::expect_equal(expected_output, observed_output) }) test_that("derive_blfl sdmt_in validations work", { @@ -44,24 +47,38 @@ test_that("derive_blfl sdmt_in validations work", { d$sdtm_in |> dplyr::select(-DOMAIN) - expect_snapshot_error(derive_blfl( + expect_error(derive_blfl( sdtm_in = sdmt_in_no_domain, dm_domain = d$dm, tgt_var = "VSLOBXFL", ref_var = "RFXSTDTC" - )) + ), ".*Required variable `DOMAIN` is missing in `sdtm_in`.*") + + # expect_snapshot_error(derive_blfl( + # sdtm_in = sdmt_in_no_domain, + # dm_domain = d$dm, + # tgt_var = "VSLOBXFL", + # ref_var = "RFXSTDTC" + # )) sdmt_in_no_id_vars <- d$sdtm_in |> dplyr::select(-sdtm.oak::oak_id_vars()) - expect_snapshot_error(derive_blfl( + expect_error(derive_blfl( sdtm_in = sdmt_in_no_id_vars, dm_domain = d$dm, tgt_var = "VSLOBXFL", ref_var = "RFXSTDTC" )) + # expect_snapshot_error(derive_blfl( + # sdtm_in = sdmt_in_no_id_vars, + # dm_domain = d$dm, + # tgt_var = "VSLOBXFL", + # ref_var = "RFXSTDTC" + # )) + sdmt_in_no_vs_vars <- d$sdtm_in |> dplyr::select(-c( @@ -71,12 +88,19 @@ test_that("derive_blfl sdmt_in validations work", { "VSDTC" )) - expect_snapshot_error(derive_blfl( + expect_error(derive_blfl( sdtm_in = sdmt_in_no_vs_vars, dm_domain = d$dm, tgt_var = "VSLOBXFL", ref_var = "RFXSTDTC" )) + + # expect_snapshot_error(derive_blfl( + # sdtm_in = sdmt_in_no_vs_vars, + # dm_domain = d$dm, + # tgt_var = "VSLOBXFL", + # ref_var = "RFXSTDTC" + # )) }) test_that("derive_blfl dm_domain validations work", { @@ -84,35 +108,64 @@ test_that("derive_blfl dm_domain validations work", { d$dm |> dplyr::select(-c(RFXSTDTC, USUBJID)) - expect_snapshot_error(derive_blfl( + expect_error(derive_blfl( sdtm_in = d$sdtm_in, dm_domain = dm_no_vars, tgt_var = "VSLOBXFL", ref_var = "RFXSTDTC" )) + + # expect_snapshot_error(derive_blfl( + # sdtm_in = d$sdtm_in, + # dm_domain = dm_no_vars, + # tgt_var = "VSLOBXFL", + # ref_var = "RFXSTDTC" + # )) }) test_that("derive_blfl tgt_var and ref_var validations work", { - expect_snapshot_error(derive_blfl( + + expect_error(derive_blfl( sdtm_in = d$sdtm_in, dm_domain = d$dm, tgt_var = list("bad"), ref_var = "RFXSTDTC" )) - expect_snapshot_error(derive_blfl( + # expect_snapshot_error(derive_blfl( + # sdtm_in = d$sdtm_in, + # dm_domain = d$dm, + # tgt_var = list("bad"), + # ref_var = "RFXSTDTC" + # )) + + expect_error(derive_blfl( sdtm_in = d$sdtm_in, dm_domain = d$dm, tgt_var = "VSLOBXFL", ref_var = d$dm )) - expect_snapshot_error(derive_blfl( + # expect_snapshot_error(derive_blfl( + # sdtm_in = d$sdtm_in, + # dm_domain = d$dm, + # tgt_var = "VSLOBXFL", + # ref_var = d$dm + # )) + + expect_error(derive_blfl( sdtm_in = d$sdtm_in, dm_domain = d$dm, tgt_var = "DMLOBXFL", ref_var = "RFXSTDTC" )) + + # expect_snapshot_error(derive_blfl( + # sdtm_in = d$sdtm_in, + # dm_domain = d$dm, + # tgt_var = "DMLOBXFL", + # ref_var = "RFXSTDTC" + # )) }) test_that("derive_blfl DOMAIN validation works", { @@ -120,12 +173,19 @@ test_that("derive_blfl DOMAIN validation works", { d$sdtm_in |> dplyr::mutate(DOMAIN = 4L) - expect_snapshot_error(derive_blfl( + expect_error(derive_blfl( sdtm_in = sdtm_in_bad_domain, dm_domain = d$dm, tgt_var = "VSLOBXFL", ref_var = "RFXSTDTC" )) + + # expect_snapshot_error(derive_blfl( + # sdtm_in = sdtm_in_bad_domain, + # dm_domain = d$dm, + # tgt_var = "VSLOBXFL", + # ref_var = "RFXSTDTC" + # )) }) test_that("`dtc_datepart`: basic usage", { From bddef68a74427fe3117969de6da0b71019dd4396 Mon Sep 17 00:00:00 2001 From: Rammprasad Ganapathy Date: Thu, 25 Jul 2024 21:00:42 +0000 Subject: [PATCH 2/3] Test case updates. Working fine locally --- tests/testthat/_snaps/derive_blfl.md | 112 --------------------------- tests/testthat/test-derive_blfl.R | 84 ++++++-------------- 2 files changed, 22 insertions(+), 174 deletions(-) delete mode 100644 tests/testthat/_snaps/derive_blfl.md diff --git a/tests/testthat/_snaps/derive_blfl.md b/tests/testthat/_snaps/derive_blfl.md deleted file mode 100644 index 606a22b3..00000000 --- a/tests/testthat/_snaps/derive_blfl.md +++ /dev/null @@ -1,112 +0,0 @@ -# derive_blfl example works - - { - "type": "list", - "attributes": { - "class": { - "type": "character", - "attributes": {}, - "value": ["tbl_df", "tbl", "data.frame"] - }, - "row.names": { - "type": "integer", - "attributes": {}, - "value": [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11] - }, - "names": { - "type": "character", - "attributes": {}, - "value": ["DOMAIN", "oak_id", "raw_source", "patient_number", "USUBJID", "VSDTC", "VSTESTCD", "VSORRES", "VSSTAT", "VISIT", "VSLOBXFL"] - } - }, - "value": [ - { - "type": "character", - "attributes": {}, - "value": ["VS", "VS", "VS", "VS", "VS", "VS", "VS", "VS", "VS", "VS", "VS"] - }, - { - "type": "integer", - "attributes": {}, - "value": [1, 2, 1, 2, 1, 2, 1, 1, 2, 2, 3] - }, - { - "type": "character", - "attributes": {}, - "value": ["VTLS1", "VTLS1", "VTLS1", "VTLS1", "VTLS2", "VTLS2", "VTLS1", "VTLS1", "VTLS1", "VTLS1", "VTLS1"] - }, - { - "type": "integer", - "attributes": {}, - "value": [375, 375, 375, 375, 375, 375, 376, 376, 376, 378, 378] - }, - { - "type": "character", - "attributes": {}, - "value": ["test_study-375", "test_study-375", "test_study-375", "test_study-375", "test_study-375", "test_study-375", "test_study-376", "test_study-376", "test_study-376", "test_study-378", "test_study-378"] - }, - { - "type": "character", - "attributes": {}, - "value": ["2020-09-01T13:31", "2020-10-01T11:20", "2020-09-28T10:10", "2020-10-01T13:31", "2020-09-28T10:10", "2020-09-28T10:05", "2020-09-20", "2020-09-20", "2020-09-20", "2020-01-20T10:00", "2020-01-21T11:00"] - }, - { - "type": "character", - "attributes": {}, - "value": ["DIABP", "DIABP", "PULSE", "PULSE", "SYSBP", "SYSBP", "DIABP", "PULSE", "PULSE", "PULSE", "PULSE"] - }, - { - "type": "character", - "attributes": {}, - "value": ["90", "90", "ND", "85", "120", "120", "75", null, "110", "110", "105"] - }, - { - "type": "character", - "attributes": {}, - "value": [null, null, null, null, null, null, null, "NOT DONE", null, null, null] - }, - { - "type": "character", - "attributes": {}, - "value": ["SCREENING", "SCREENING", "SCREENING", "SCREENING", "SCREENING", "SCREENING", "SCREENING", "SCREENING", "SCREENING", "SCREENING", "SCREENING"] - }, - { - "type": "character", - "attributes": {}, - "value": ["Y", null, null, null, "Y", null, "Y", null, "Y", "Y", null] - } - ] - } - -# derive_blfl sdmt_in validations work - - Required variable `DOMAIN` is missing - ---- - - Required variables `oak_id`, `raw_source` and `patient_number` are missing - ---- - - Required variables `VSORRES`, `VSSTAT`, `VSTESTCD` and `VSDTC` are missing - -# derive_blfl dm_domain validations work - - Required variables `USUBJID` and `RFXSTDTC` are missing - -# derive_blfl tgt_var and ref_var validations work - - `tgt_var` must be a character scalar but is a list - ---- - - `ref_var` must be a character scalar but is a data frame - ---- - - `tgt_var` must be one of 'VSBLFL' or 'VSLOBXFL' but is 'DMLOBXFL' - -# derive_blfl DOMAIN validation works - - `domain` must be a character scalar but is `4` - diff --git a/tests/testthat/test-derive_blfl.R b/tests/testthat/test-derive_blfl.R index 65dcc8c6..c7054d54 100644 --- a/tests/testthat/test-derive_blfl.R +++ b/tests/testthat/test-derive_blfl.R @@ -34,12 +34,23 @@ test_that("derive_blfl example works", { ref_var = "RFXSTDTC", baseline_visits = c("SCREENING") ) - observed_output - # expect_snapshot_value(observed_output, style = "json2") - expected_output <- observed_output + expected_output <- tibble::tribble( + ~DOMAIN, ~oak_id, ~raw_source, ~patient_number, ~USUBJID, ~VSDTC, ~VSTESTCD, ~VSORRES, ~VSSTAT, ~VISIT, ~VSLOBXFL, # nolint + "VS", 1L, "VTLS1", 375L, "test_study-375", "2020-09-01T13:31", "DIABP", "90", NA, "SCREENING", "Y", # nolint + "VS", 2L, "VTLS1", 375L, "test_study-375", "2020-10-01T11:20", "DIABP", "90", NA, "SCREENING", NA, # nolint + "VS", 1L, "VTLS1", 375L, "test_study-375", "2020-09-28T10:10", "PULSE", "ND", NA, "SCREENING", NA, # nolint + "VS", 2L, "VTLS1", 375L, "test_study-375", "2020-10-01T13:31", "PULSE", "85", NA, "SCREENING", NA, # nolint + "VS", 1L, "VTLS2", 375L, "test_study-375", "2020-09-28T10:10", "SYSBP", "120", NA, "SCREENING", "Y", # nolint + "VS", 2L, "VTLS2", 375L, "test_study-375", "2020-09-28T10:05", "SYSBP", "120", NA, "SCREENING", NA, # nolint + "VS", 1L, "VTLS1", 376L, "test_study-376", "2020-09-20", "DIABP", "75", NA, "SCREENING", "Y", # nolint + "VS", 1L, "VTLS1", 376L, "test_study-376", "2020-09-20", "PULSE", NA, "NOT DONE", "SCREENING", NA, # nolint + "VS", 2L, "VTLS1", 376L, "test_study-376", "2020-09-20", "PULSE", "110", NA, "SCREENING", "Y", # nolint + "VS", 2L, "VTLS1", 378L, "test_study-378", "2020-01-20T10:00", "PULSE", "110", NA, "SCREENING", "Y", # nolint + "VS", 3L, "VTLS1", 378L, "test_study-378", "2020-01-21T11:00", "PULSE", "105", NA, "SCREENING", NA # nolint + ) - testthat::expect_equal(expected_output, observed_output) + testthat::expect_identical(expected_output, observed_output) }) test_that("derive_blfl sdmt_in validations work", { @@ -54,13 +65,6 @@ test_that("derive_blfl sdmt_in validations work", { ref_var = "RFXSTDTC" ), ".*Required variable `DOMAIN` is missing in `sdtm_in`.*") - # expect_snapshot_error(derive_blfl( - # sdtm_in = sdmt_in_no_domain, - # dm_domain = d$dm, - # tgt_var = "VSLOBXFL", - # ref_var = "RFXSTDTC" - # )) - sdmt_in_no_id_vars <- d$sdtm_in |> dplyr::select(-sdtm.oak::oak_id_vars()) @@ -70,14 +74,8 @@ test_that("derive_blfl sdmt_in validations work", { dm_domain = d$dm, tgt_var = "VSLOBXFL", ref_var = "RFXSTDTC" - )) + ), ".*Required variables `oak_id`, `raw_source`, and `patient_number` are missing in `sdtm_in`.*") - # expect_snapshot_error(derive_blfl( - # sdtm_in = sdmt_in_no_id_vars, - # dm_domain = d$dm, - # tgt_var = "VSLOBXFL", - # ref_var = "RFXSTDTC" - # )) sdmt_in_no_vs_vars <- d$sdtm_in |> @@ -93,14 +91,8 @@ test_that("derive_blfl sdmt_in validations work", { dm_domain = d$dm, tgt_var = "VSLOBXFL", ref_var = "RFXSTDTC" - )) + ), ".*Required variables `VSORRES`, `VSSTAT`, `VSTESTCD`, and `VSDTC` are missing in `sdtm_in`.*") - # expect_snapshot_error(derive_blfl( - # sdtm_in = sdmt_in_no_vs_vars, - # dm_domain = d$dm, - # tgt_var = "VSLOBXFL", - # ref_var = "RFXSTDTC" - # )) }) test_that("derive_blfl dm_domain validations work", { @@ -113,14 +105,8 @@ test_that("derive_blfl dm_domain validations work", { dm_domain = dm_no_vars, tgt_var = "VSLOBXFL", ref_var = "RFXSTDTC" - )) + ), ".*Required variables `USUBJID` and `RFXSTDTC` are missing in `dm_domain`.*") - # expect_snapshot_error(derive_blfl( - # sdtm_in = d$sdtm_in, - # dm_domain = dm_no_vars, - # tgt_var = "VSLOBXFL", - # ref_var = "RFXSTDTC" - # )) }) test_that("derive_blfl tgt_var and ref_var validations work", { @@ -130,42 +116,22 @@ test_that("derive_blfl tgt_var and ref_var validations work", { dm_domain = d$dm, tgt_var = list("bad"), ref_var = "RFXSTDTC" - )) - - # expect_snapshot_error(derive_blfl( - # sdtm_in = d$sdtm_in, - # dm_domain = d$dm, - # tgt_var = list("bad"), - # ref_var = "RFXSTDTC" - # )) + ), ".*Argument `tgt_var` must be a scalar of class*") expect_error(derive_blfl( sdtm_in = d$sdtm_in, dm_domain = d$dm, tgt_var = "VSLOBXFL", ref_var = d$dm - )) - - # expect_snapshot_error(derive_blfl( - # sdtm_in = d$sdtm_in, - # dm_domain = d$dm, - # tgt_var = "VSLOBXFL", - # ref_var = d$dm - # )) + ), ".*Argument `ref_var` must be a scalar of class*") expect_error(derive_blfl( sdtm_in = d$sdtm_in, dm_domain = d$dm, tgt_var = "DMLOBXFL", ref_var = "RFXSTDTC" - )) + ), ".*Argument `tgt_var` must be equal to one of.*") - # expect_snapshot_error(derive_blfl( - # sdtm_in = d$sdtm_in, - # dm_domain = d$dm, - # tgt_var = "DMLOBXFL", - # ref_var = "RFXSTDTC" - # )) }) test_that("derive_blfl DOMAIN validation works", { @@ -178,14 +144,8 @@ test_that("derive_blfl DOMAIN validation works", { dm_domain = d$dm, tgt_var = "VSLOBXFL", ref_var = "RFXSTDTC" - )) + ), ".*Argument `domain` must be a scalar of class.*") - # expect_snapshot_error(derive_blfl( - # sdtm_in = sdtm_in_bad_domain, - # dm_domain = d$dm, - # tgt_var = "VSLOBXFL", - # ref_var = "RFXSTDTC" - # )) }) test_that("`dtc_datepart`: basic usage", { From 8b8db505b0b5804eea59032605989bf774b4b6f0 Mon Sep 17 00:00:00 2001 From: Rammprasad Ganapathy Date: Thu, 25 Jul 2024 22:14:40 +0000 Subject: [PATCH 3/3] fix pipeline failures --- man/mutate.cnd_df.Rd | 1 - tests/testthat/test-derive_blfl.R | 29 ++++++++++++----------------- 2 files changed, 12 insertions(+), 18 deletions(-) diff --git a/man/mutate.cnd_df.Rd b/man/mutate.cnd_df.Rd index df689006..de6ec25a 100644 --- a/man/mutate.cnd_df.Rd +++ b/man/mutate.cnd_df.Rd @@ -55,4 +55,3 @@ generic on conditioned data frames. This function implements a conditional mutate by only changing rows for which the condition stored in the conditioned data frame is \code{TRUE}. } -\keyword{internal} \ No newline at end of file diff --git a/tests/testthat/test-derive_blfl.R b/tests/testthat/test-derive_blfl.R index c7054d54..5d2ce067 100644 --- a/tests/testthat/test-derive_blfl.R +++ b/tests/testthat/test-derive_blfl.R @@ -36,18 +36,18 @@ test_that("derive_blfl example works", { ) expected_output <- tibble::tribble( - ~DOMAIN, ~oak_id, ~raw_source, ~patient_number, ~USUBJID, ~VSDTC, ~VSTESTCD, ~VSORRES, ~VSSTAT, ~VISIT, ~VSLOBXFL, # nolint - "VS", 1L, "VTLS1", 375L, "test_study-375", "2020-09-01T13:31", "DIABP", "90", NA, "SCREENING", "Y", # nolint - "VS", 2L, "VTLS1", 375L, "test_study-375", "2020-10-01T11:20", "DIABP", "90", NA, "SCREENING", NA, # nolint - "VS", 1L, "VTLS1", 375L, "test_study-375", "2020-09-28T10:10", "PULSE", "ND", NA, "SCREENING", NA, # nolint - "VS", 2L, "VTLS1", 375L, "test_study-375", "2020-10-01T13:31", "PULSE", "85", NA, "SCREENING", NA, # nolint - "VS", 1L, "VTLS2", 375L, "test_study-375", "2020-09-28T10:10", "SYSBP", "120", NA, "SCREENING", "Y", # nolint - "VS", 2L, "VTLS2", 375L, "test_study-375", "2020-09-28T10:05", "SYSBP", "120", NA, "SCREENING", NA, # nolint - "VS", 1L, "VTLS1", 376L, "test_study-376", "2020-09-20", "DIABP", "75", NA, "SCREENING", "Y", # nolint - "VS", 1L, "VTLS1", 376L, "test_study-376", "2020-09-20", "PULSE", NA, "NOT DONE", "SCREENING", NA, # nolint - "VS", 2L, "VTLS1", 376L, "test_study-376", "2020-09-20", "PULSE", "110", NA, "SCREENING", "Y", # nolint - "VS", 2L, "VTLS1", 378L, "test_study-378", "2020-01-20T10:00", "PULSE", "110", NA, "SCREENING", "Y", # nolint - "VS", 3L, "VTLS1", 378L, "test_study-378", "2020-01-21T11:00", "PULSE", "105", NA, "SCREENING", NA # nolint + ~DOMAIN, ~oak_id, ~raw_source, ~patient_number, ~USUBJID, ~VSDTC, ~VSTESTCD, ~VSORRES, ~VSSTAT, ~VISIT, ~VSLOBXFL, # nolint + "VS", 1L, "VTLS1", 375L, "test_study-375", "2020-09-01T13:31", "DIABP", "90", NA, "SCREENING", "Y", # nolint + "VS", 2L, "VTLS1", 375L, "test_study-375", "2020-10-01T11:20", "DIABP", "90", NA, "SCREENING", NA, # nolint + "VS", 1L, "VTLS1", 375L, "test_study-375", "2020-09-28T10:10", "PULSE", "ND", NA, "SCREENING", NA, # nolint + "VS", 2L, "VTLS1", 375L, "test_study-375", "2020-10-01T13:31", "PULSE", "85", NA, "SCREENING", NA, # nolint + "VS", 1L, "VTLS2", 375L, "test_study-375", "2020-09-28T10:10", "SYSBP", "120", NA, "SCREENING", "Y", # nolint + "VS", 2L, "VTLS2", 375L, "test_study-375", "2020-09-28T10:05", "SYSBP", "120", NA, "SCREENING", NA, # nolint + "VS", 1L, "VTLS1", 376L, "test_study-376", "2020-09-20", "DIABP", "75", NA, "SCREENING", "Y", # nolint + "VS", 1L, "VTLS1", 376L, "test_study-376", "2020-09-20", "PULSE", NA, "NOT DONE", "SCREENING", NA, # nolint + "VS", 2L, "VTLS1", 376L, "test_study-376", "2020-09-20", "PULSE", "110", NA, "SCREENING", "Y", # nolint + "VS", 2L, "VTLS1", 378L, "test_study-378", "2020-01-20T10:00", "PULSE", "110", NA, "SCREENING", "Y", # nolint + "VS", 3L, "VTLS1", 378L, "test_study-378", "2020-01-21T11:00", "PULSE", "105", NA, "SCREENING", NA # nolint ) testthat::expect_identical(expected_output, observed_output) @@ -92,7 +92,6 @@ test_that("derive_blfl sdmt_in validations work", { tgt_var = "VSLOBXFL", ref_var = "RFXSTDTC" ), ".*Required variables `VSORRES`, `VSSTAT`, `VSTESTCD`, and `VSDTC` are missing in `sdtm_in`.*") - }) test_that("derive_blfl dm_domain validations work", { @@ -106,11 +105,9 @@ test_that("derive_blfl dm_domain validations work", { tgt_var = "VSLOBXFL", ref_var = "RFXSTDTC" ), ".*Required variables `USUBJID` and `RFXSTDTC` are missing in `dm_domain`.*") - }) test_that("derive_blfl tgt_var and ref_var validations work", { - expect_error(derive_blfl( sdtm_in = d$sdtm_in, dm_domain = d$dm, @@ -131,7 +128,6 @@ test_that("derive_blfl tgt_var and ref_var validations work", { tgt_var = "DMLOBXFL", ref_var = "RFXSTDTC" ), ".*Argument `tgt_var` must be equal to one of.*") - }) test_that("derive_blfl DOMAIN validation works", { @@ -145,7 +141,6 @@ test_that("derive_blfl DOMAIN validation works", { tgt_var = "VSLOBXFL", ref_var = "RFXSTDTC" ), ".*Argument `domain` must be a scalar of class.*") - }) test_that("`dtc_datepart`: basic usage", {