tests/testthat/test-derive_blfl.R

In sdtm.oak: SDTM Data Transformation Engine

dm <- tibble::tribble(
  ~USUBJID, ~RFSTDTC, ~RFXSTDTC,
  "test_study-375", "2020-09-28T10:10", "2020-09-28T10:10",
  "test_study-376", "2020-09-21T11:00", "2020-09-21T11:00",
  "test_study-377", NA, NA,
  "test_study-378", "2020-01-20T10:00", "2020-01-20T10:00",
  "test_study-379", NA, NA
)

sdtm_in <-
  tibble::tribble(
    ~DOMAIN, ~oak_id, ~raw_source, ~patient_number, ~USUBJID, ~VSDTC, ~VSTESTCD, ~VSORRES, ~VSSTAT, ~VISIT, ~VSTPT,
    "VS", 1L, "VTLS1", 375L, "test_study-375", "2020-09-01T13:31", "DIABP", "90", NA, "SCREENING", "PRE-DOSE",
    "VS", 2L, "VTLS1", 375L, "test_study-375", "2020-10-01T11:20", "DIABP", "90", NA, "SCREENING", "30 DAY POST-DOSE",
    "VS", 1L, "VTLS1", 375L, "test_study-375", "2020-09-28T10:10", "PULSE", "ND", NA, "SCREENING", "28 DAY POST-DOSE",
    "VS", 2L, "VTLS1", 375L, "test_study-375", "2020-10-01T13:31", "PULSE", "85", NA, "SCREENING", "30 DAY POST-DOSE",
    "VS", 1L, "VTLS2", 375L, "test_study-375", "2020-09-28T10:10", "SYSBP", "120", NA, "SCREENING", "28 DAY POST-DOSE",
    "VS", 2L, "VTLS2", 375L, "test_study-375", "2020-09-28T10:05", "SYSBP", "120", NA, "SCREENING", "28 DAY POST-DOSE",
    "VS", 1L, "VTLS1", 376L, "test_study-376", "2020-09-20", "DIABP", "75", NA, "SCREENING", "PRE-DOSE",
    "VS", 1L, "VTLS1", 376L, "test_study-376", "2020-09-20", "PULSE", NA, "NOT DONE", "SCREENING", "PRE-DOSE", # nolint
    "VS", 2L, "VTLS1", 376L, "test_study-376", "2020-09-20", "PULSE", "110", NA, "SCREENING", "PRE-DOSE",
    "VS", 2L, "VTLS1", 378L, "test_study-378", "2020-01-20T10:00", "PULSE", "110", NA, "SCREENING", "PRE-DOSE",
    "VS", 3L, "VTLS1", 378L, "test_study-378", "2020-01-21T11:00", "PULSE", "105", NA, "SCREENING", "1 DAY POST-DOSE"
  )

d <- list(sdtm_in = sdtm_in, dm = dm)


test_that("derive_blfl example works", {
  observed_output <- derive_blfl(
    sdtm_in = d$sdtm_in,
    dm_domain = d$dm,
    tgt_var = "VSLOBXFL",
    ref_var = "RFXSTDTC",
    baseline_visits = c("SCREENING"),
    baseline_timepoints = c("PRE-DOSE")
  )
  observed_output

  expect_snapshot_value(observed_output, style = "json2")
})

test_that("derive_blfl sdmt_in validations work", {
  sdmt_in_no_domain <-
    d$sdtm_in |>
    dplyr::select(-DOMAIN)

  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(
    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(
      "VSORRES",
      "VSSTAT",
      "VSTESTCD",
      "VSDTC"
    ))

  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", {
  dm_no_vars <-
    d$dm |>
    dplyr::select(-c(RFXSTDTC, USUBJID))

  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(
    sdtm_in = d$sdtm_in,
    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 = "VSLOBXFL",
    ref_var = d$dm
  ))

  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", {
  sdtm_in_bad_domain <-
    d$sdtm_in |>
    dplyr::mutate(DOMAIN = 4L)

  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", {
  expect_identical(
    dtc_datepart(
      c(NA, "", "2021", "2021-12", "2021-12-25", "2021-12-25T12:00:00")
    ),
    c(NA, NA, NA, NA, "2021-12-25", "2021-12-25")
  )

  ## Prevent partial or missing dates from being set to NA
  expect_identical(
    dtc_datepart(
      c(NA, "", "2021", "2021-12", "2021-12-25", "2021-12-25T12:00:00"),
      partial_as_na = FALSE
    ),
    c(NA, "", "2021", "2021-12", "2021-12-25", "2021-12-25")
  )
})

test_that("`dtc_timepart`: basic usage", {
  # Partial or missing times set to NA and seconds ignored by default
  expect_identical(dtc_timepart(
    c(
      NA,
      "",
      "2021-12-25",
      "2021-12-25T12",
      "2021-12-25T12:30",
      "2021-12-25T12:30:59"
    )
  ), c(NA, NA, NA, NA, "12:30", "12:30"))

  # Prevent partial or missing times from being set to NA
  expect_identical(
    dtc_timepart(
      c(
        NA,
        "",
        "2021-12-25",
        "2021-12-25T12",
        "2021-12-25T12:30",
        "2021-12-25T12:30:59"
      ),
      partial_as_na = FALSE
    ),
    c(NA, "", "", "12", "12:30", "12:30")
  )

  # Do not ignore seconds, partial or missing times set to NA
  expect_identical(
    dtc_timepart(
      c(
        NA,
        "",
        "2021-12-25",
        "2021-12-25T12",
        "2021-12-25T12:30",
        "2021-12-25T12:30:59"
      ),
      ignore_seconds = FALSE
    ),
    c(NA, NA, NA, NA, NA, "12:30:59")
  )

  # Do not ignore seconds and prevent partial or missing times from being set to NA
  expect_identical(
    dtc_timepart(
      c(
        NA,
        "",
        "2021-12-25",
        "2021-12-25T12",
        "2021-12-25T12:30",
        "2021-12-25T12:30:59"
      ),
      partial_as_na = FALSE,
      ignore_seconds = FALSE
    ),
    c(NA, "", "", "12", "12:30", "12:30:59")
  )
})