test-derive_param_exposure.R
In admiral: ADaM in R Asset Library

input <- tibble::tribble(
  ~USUBJID, ~VISIT, ~PARAMCD, ~AVAL, ~AVALC, ~EXSTDTC, ~EXENDTC,
  "01-701-1015", "BASELINE", "DOSE", 80, NA, "2020-07-01", "2020-07-14",
  "01-701-1015", "WEEK 2", "DOSE", 80, NA, "2020-07-15", "2020-09-23",
  "01-701-1015", "WEEK 12", "DOSE", 65, NA, "2020-09-24", "2020-12-16",
  "01-701-1015", "WEEK 24", "DOSE", 65, NA, "2020-12-17", "2021-06-02",
  "01-701-1015", "BASELINE", "ADJ", NA, NA, "2020-07-01", "2020-07-14",
  "01-701-1015", "WEEK 2", "ADJ", NA, "Y", "2020-07-15", "2020-09-23",
  "01-701-1015", "WEEK 12", "ADJ", NA, "Y", "2020-09-24", "2020-12-16",
  "01-701-1015", "WEEK 24", "ADJ", NA, NA, "2020-12-17", "2021-06-02",
  "01-701-1281", "BASELINE", "DOSE", 80, NA, "2020-07-03", "2020-07-18",
  "01-701-1281", "WEEK 2", "DOSE", 80, NA, "2020-07-19", "2020-10-01",
  "01-701-1281", "WEEK 12", "DOSE", 82, NA, "2020-10-02", "2020-12-01",
  "01-701-1281", "BASELINE", "ADJ", NA, NA, "2020-07-03", "2020-07-18",
  "01-701-1281", "WEEK 2", "ADJ", NA, NA, "2020-07-19", "2020-10-01",
  "01-701-1281", "WEEK 12", "ADJ", NA, NA, "2020-10-02", "2020-12-01"
) %>%
  mutate(
    ASTDTM = ymd_hms(paste(EXSTDTC, "T00:00:00")),
    ASTDT = date(ASTDTM),
    AENDTM = ymd_hms(paste(EXENDTC, "T00:00:00")),
    AENDT = date(AENDTM)
  )

input_no_dtm <- input %>%
  select(-ASTDTM, -AENDTM)

## Test 1: works with DTM variables ----
test_that("derive_param_exposure Test 1: works with DTM variables", {
  new_obs1 <- input %>%
    filter(PARAMCD == "DOSE") %>%
    group_by(USUBJID) %>%
    summarise(
      AVAL = sum(AVAL, na.rm = TRUE),
      ASTDTM = min(ASTDTM, na.rm = TRUE),
      AENDTM = max(AENDTM, na.rm = TRUE)
    ) %>%
    mutate(PARAMCD = "TDOSE", PARCAT1 = "OVERALL", ASTDT = date(ASTDTM), AENDT = date(AENDTM))

  new_obs2 <- input %>%
    filter(PARAMCD == "DOSE") %>%
    group_by(USUBJID) %>%
    summarise(
      AVAL = mean(AVAL, na.rm = TRUE),
      ASTDTM = min(ASTDTM, na.rm = TRUE),
      AENDTM = max(AENDTM, na.rm = TRUE)
    ) %>%
    mutate(PARAMCD = "AVDOSE", PARCAT1 = "OVERALL", ASTDT = date(ASTDTM), AENDT = date(AENDTM))

  new_obs3 <- input %>%
    filter(PARAMCD == "ADJ") %>%
    group_by(USUBJID) %>%
    summarise(
      AVALC = if_else(sum(!is.na(AVALC)) > 0, "Y", NA_character_),
      ASTDTM = min(ASTDTM, na.rm = TRUE),
      AENDTM = max(AENDTM, na.rm = TRUE)
    ) %>%
    mutate(PARAMCD = "TADJ", PARCAT1 = "OVERALL", ASTDT = date(ASTDTM), AENDT = date(AENDTM))

  expected_output <- bind_rows(input, new_obs1, new_obs2, new_obs3)

  actual_output <- input %>%
    derive_param_exposure(
      by_vars = exprs(USUBJID),
      input_code = "DOSE",
      analysis_var = AVAL,
      summary_fun = function(x) sum(x, na.rm = TRUE),
      set_values_to = exprs(PARAMCD = "TDOSE", PARCAT1 = "OVERALL")
    ) %>%
    derive_param_exposure(
      by_vars = exprs(USUBJID),
      input_code = "DOSE",
      analysis_var = AVAL,
      summary_fun = function(x) mean(x, na.rm = TRUE),
      set_values_to = exprs(PARAMCD = "AVDOSE", PARCAT1 = "OVERALL")
    ) %>%
    derive_param_exposure(
      by_vars = exprs(USUBJID),
      input_code = "ADJ",
      analysis_var = AVALC,
      summary_fun = function(x) if_else(sum(!is.na(x)) > 0, "Y", NA_character_),
      set_values_to = exprs(PARAMCD = "TADJ", PARCAT1 = "OVERALL")
    )

  expect_dfs_equal(
    actual_output,
    expected_output,
    keys = c("USUBJID", "VISIT", "PARAMCD")
  )
})

## Test 2: works with DT variables ----
test_that("derive_param_exposure Test 2: works with DT variables", {
  new_obs1 <- input_no_dtm %>%
    filter(PARAMCD == "DOSE") %>%
    group_by(USUBJID) %>%
    summarise(
      AVAL = sum(AVAL, na.rm = TRUE),
      ASTDT = min(ASTDT, na.rm = TRUE),
      AENDT = max(AENDT, na.rm = TRUE)
    ) %>%
    mutate(PARAMCD = "TDOSE", PARCAT1 = "OVERALL")

  new_obs2 <- input_no_dtm %>%
    filter(PARAMCD == "DOSE") %>%
    group_by(USUBJID) %>%
    summarise(
      AVAL = mean(AVAL, na.rm = TRUE),
      ASTDT = min(ASTDT, na.rm = TRUE),
      AENDT = max(AENDT, na.rm = TRUE)
    ) %>%
    mutate(PARAMCD = "AVDOSE", PARCAT1 = "OVERALL")

  new_obs3 <- input_no_dtm %>%
    filter(PARAMCD == "ADJ") %>%
    group_by(USUBJID) %>%
    summarise(
      AVALC = if_else(sum(!is.na(AVALC)) > 0, "Y", NA_character_),
      ASTDT = min(ASTDT, na.rm = TRUE),
      AENDT = max(AENDT, na.rm = TRUE)
    ) %>%
    mutate(PARAMCD = "TADJ", PARCAT1 = "OVERALL")

  expected_output <- bind_rows(input_no_dtm, new_obs1, new_obs2, new_obs3)

  actual_output <- input_no_dtm %>%
    derive_param_exposure(
      by_vars = exprs(USUBJID),
      input_code = "DOSE",
      analysis_var = AVAL,
      summary_fun = function(x) sum(x, na.rm = TRUE),
      set_values_to = exprs(PARAMCD = "TDOSE", PARCAT1 = "OVERALL")
    ) %>%
    derive_param_exposure(
      by_vars = exprs(USUBJID),
      input_code = "DOSE",
      analysis_var = AVAL,
      summary_fun = function(x) mean(x, na.rm = TRUE),
      set_values_to = exprs(PARAMCD = "AVDOSE", PARCAT1 = "OVERALL")
    ) %>%
    derive_param_exposure(
      by_vars = exprs(USUBJID),
      input_code = "ADJ",
      analysis_var = AVALC,
      summary_fun = function(x) if_else(sum(!is.na(x)) > 0, "Y", NA_character_),
      set_values_to = exprs(PARAMCD = "TADJ", PARCAT1 = "OVERALL")
    )

  expect_dfs_equal(
    actual_output,
    expected_output,
    keys = c("USUBJID", "VISIT", "PARAMCD")
  )
})

## Test 3: Errors ----
test_that("derive_param_exposure Test 3: Errors", {
  # PARAMCD must be specified
  expect_error(
    input <- input %>%
      derive_param_exposure(
        by_vars = exprs(USUBJID),
        input_code = "DOSE",
        analysis_var = AVAL,
        summary_fun = function(x) mean(x, na.rm = TRUE),
        set_values_to = exprs(PARCAT1 = "OVERALL")
      ),
    regexp = paste("The following required elements are missing in `set_values_to`: 'PARAMCD'")
  )
  # input code must be present
  expect_error(
    input <- input %>%
      derive_param_exposure(
        by_vars = exprs(USUBJID),
        input_code = "DOSED",
        analysis_var = AVAL,
        summary_fun = function(x) mean(x, na.rm = TRUE),
        set_values_to = exprs(PARAMCD = "TDOSE", PARCAT1 = "OVERALL")
      ),
    regexp = paste(
      "`input_code` contains invalid values:\n`DOSED`\nValid",
      "values:\n`DOSE` and `ADJ`"
    )
  )

  # ASTDTM/AENDTM or ASTDT/AENDT must be present
  expect_error(
    input <- input %>%
      select(-starts_with("AST"), -starts_with("AEN")) %>%
      derive_param_exposure(
        by_vars = exprs(USUBJID),
        input_code = "DOSE",
        analysis_var = AVAL,
        summary_fun = function(x) mean(x, na.rm = TRUE),
        set_values_to = exprs(PARCAT1 = "OVERALL")
      ),
    regexp = paste("Required variables `ASTDT` and `AENDT` are missing")
  )
})