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

# derive_extreme_records ----
## Test 1: `mode` = first ----
test_that("derive_extreme_records Test 1: `mode` = first", {
  input <- tibble::tribble(
    ~USUBJID, ~PARAMCD,       ~AVALC,        ~ADY,
    "1",      "NO SLEEP",     "N",              1,
    "1",      "WAKE UP",      "N",              2,
    "1",      "FALL ASLEEP",  "N",              3,
    "2",      "NO SLEEP",     "N",              1,
    "2",      "WAKE UP",      "Y",              2,
    "2",      "WAKE UP",      "Y",              3,
    "2",      "FALL ASLEEP",  "N",              4,
    "3",      "NO SLEEP",     NA_character_,    1
  )

  expected_output <- bind_rows(
    input,
    tibble::tribble(
      ~USUBJID, ~PARAMCD, ~AVALC,                            ~AVAL, ~ADY,
      "1",      "WSP",    "No sleeping problems",                4,    1,
      "2",      "WSP",    "Waking up more than three times",     2,    2,
      "3",      "WSP",    "Missing",                            99,    1
    )
  )

  actual_output <- derive_extreme_event(
    input,
    by_vars = exprs(USUBJID),
    events = list(
      event(
        condition = PARAMCD == "NO SLEEP" & AVALC == "Y",
        set_values_to = exprs(AVALC = "No sleep", AVAL = 1)
      ),
      event(
        condition = PARAMCD == "WAKE UP" & AVALC == "Y",
        set_values_to = exprs(AVALC = "Waking up more than three times", AVAL = 2)
      ),
      event(
        condition = PARAMCD == "FALL ASLEEP" & AVALC == "Y",
        set_values_to = exprs(AVALC = "More than 30 mins to fall asleep", AVAL = 3)
      ),
      event(
        condition = all(AVALC == "N"),
        set_values_to = exprs(
          AVALC = "No sleeping problems", AVAL = 4
        )
      ),
      event(
        condition = TRUE,
        set_values_to = exprs(AVALC = "Missing", AVAL = 99)
      )
    ),
    order = exprs(ADY),
    mode = "first",
    set_values_to = exprs(
      PARAMCD = "WSP"
    ),
    check_type = "none"
  )

  expect_dfs_equal(
    base = expected_output,
    compare = actual_output,
    keys = c("USUBJID", "PARAMCD", "ADY")
  )
})

## Test 2: `mode` = last ----
test_that("derive_extreme_records Test 2: `mode` = last", {
  input <- tibble::tribble(
    ~USUBJID, ~PARAMCD,       ~AVALC,        ~ADY,
    "1",      "NO SLEEP",     "N",              1,
    "1",      "WAKE UP",      "N",              2,
    "1",      "FALL ASLEEP",  "N",              3,
    "2",      "NO SLEEP",     "N",              1,
    "2",      "WAKE UP",      "Y",              2,
    "2",      "WAKE UP",      "Y",              3,
    "2",      "FALL ASLEEP",  "N",              4,
    "3",      "NO SLEEP",     NA_character_,    1
  )

  expected_output <- bind_rows(
    input,
    tibble::tribble(
      ~USUBJID, ~PARAMCD, ~AVALC,                            ~AVAL, ~ADY,
      "1",      "WSP",    "No sleeping problems",                4,    3,
      "2",      "WSP",    "Waking up more than three times",     2,    3,
      "3",      "WSP",    "Missing",                            99,    1
    )
  )

  actual_output <- derive_extreme_event(
    input,
    by_vars = exprs(USUBJID),
    events = list(
      event(
        condition = PARAMCD == "NO SLEEP" & AVALC == "Y",
        set_values_to = exprs(AVALC = "No sleep", AVAL = 1)
      ),
      event(
        condition = PARAMCD == "WAKE UP" & AVALC == "Y",
        set_values_to = exprs(AVALC = "Waking up more than three times", AVAL = 2)
      ),
      event(
        condition = PARAMCD == "FALL ASLEEP" & AVALC == "Y",
        set_values_to = exprs(AVALC = "More than 30 mins to fall asleep", AVAL = 3)
      ),
      event(
        condition = all(AVALC == "N"),
        set_values_to = exprs(
          AVALC = "No sleeping problems", AVAL = 4
        )
      ),
      event(
        condition = TRUE,
        set_values_to = exprs(AVALC = "Missing", AVAL = 99)
      )
    ),
    order = exprs(ADY),
    mode = "last",
    set_values_to = exprs(
      PARAMCD = "WSP"
    ),
    check_type = "none"
  )

  expect_dfs_equal(
    base = expected_output,
    compare = actual_output,
    keys = c("USUBJID", "PARAMCD", "ADY")
  )
})

## Test 3: `source_datasets` works ----
test_that("derive_extreme_records Test 3: `source_datasets` works", {
  adsl <- tibble::tribble(
    ~USUBJID, ~TRTSDTC,
    "1",      "2020-01-01",
    "2",      "2019-12-12",
    "3",      "2019-11-11",
    "4",      "2019-12-30",
    "5",      "2020-01-01",
    "6",      "2020-02-02",
    "7",      "2020-02-02",
    "8",      "2020-04-01"
  ) %>%
    mutate(
      TRTSDT = lubridate::ymd(TRTSDTC),
      STUDYID = "XX1234"
    )

  adrs <- tibble::tribble(
    ~USUBJID, ~ADTC, ~AVALC,
    "1", "2020-01-01", "PR",
    "1", "2020-02-01", "CR",
    "1", "2020-02-16", "NE",
    "1", "2020-03-01", "CR",
    "1", "2020-04-01", "SD",
    "2", "2020-01-01", "SD",
    "2", "2020-02-01", "PR",
    "2", "2020-03-01", "SD",
    "2", "2020-03-13", "CR",
    "3", "2019-11-12", "CR",
    "3", "2019-12-02", "CR",
    "3", "2020-01-01", "SD",
    "4", "2020-01-01", "PR",
    "4", "2020-03-01", "SD",
    "4", "2020-04-01", "SD",
    "4", "2020-05-01", "PR",
    "4", "2020-05-15", "NON-CR/NON-PD",
    "5", "2020-01-01", "PR",
    "5", "2020-01-10", "SD",
    "5", "2020-01-20", "PR",
    "5", "2020-05-15", "NON-CR/NON-PD",
    "6", "2020-02-06", "PR",
    "6", "2020-02-16", "CR",
    "6", "2020-03-30", "PR",
    "7", "2020-02-06", "PR",
    "7", "2020-02-16", "CR",
    "7", "2020-04-01", "NE"
  ) %>%
    mutate(
      PARAMCD = "OVR",
      ADT = lubridate::ymd(ADTC),
      STUDYID = "XX1234"
    ) %>%
    select(-ADTC) %>%
    derive_vars_merged(
      dataset_add = adsl,
      by_vars = exprs(STUDYID, USUBJID),
      new_vars = exprs(TRTSDT)
    )
  expected <- bind_rows(
    adrs,
    tibble::tribble(
      ~USUBJID, ~ADTC,        ~AVALC,    ~TRTSDTC,
      "1",      "2020-02-01", "CR",      "2020-01-01",
      "2",      "2020-03-13", "CR",      "2019-12-12",
      "3",      "2019-11-12", "CR",      "2019-11-11",
      "4",      "2020-01-01", "PR",      "2019-12-30",
      "5",      "2020-01-01", "PR",      "2020-01-01",
      "6",      "2020-02-16", "CR",      "2020-02-02",
      "7",      "2020-02-16", "CR",      "2020-02-02",
      "8",      "",           "MISSING", "2020-04-01"
    ) %>%
      mutate(
        ADT = lubridate::ymd(ADTC),
        TRTSDT = lubridate::ymd(TRTSDTC),
        STUDYID = "XX1234",
        PARAMCD = "BOR",
        PARAM = "Best Overall Response"
      ) %>%
      select(-ADTC, -TRTSDTC)
  )

  actual <- derive_extreme_event(
    dataset = adrs,
    by_vars = exprs(STUDYID, USUBJID),
    order = exprs(ADT),
    mode = "first",
    source_datasets = list(adsl = adsl),
    events = list(
      event(
        condition = AVALC == "CR",
        set_values_to = exprs(
          AVALC = "CR"
        )
      ),
      event(
        condition = AVALC == "PR",
        set_values_to = exprs(
          AVALC = "PR"
        )
      ),
      event(
        condition = AVALC == "SD" & ADT >= TRTSDT + 28,
        set_values_to = exprs(
          AVALC = "SD"
        )
      ),
      event(
        condition = AVALC == "NON-CR/NON-PD" & ADT >= TRTSDT + 28,
        set_values_to = exprs(
          AVALC = "NON-CR/NON-PD"
        )
      ),
      event(
        condition = AVALC == "PD",
        set_values_to = exprs(
          AVALC = "PD"
        )
      ),
      event(
        condition = AVALC %in% c("SD", "NON-CR/NON-PD"),
        set_values_to = exprs(
          AVALC = "NE"
        )
      ),
      event(
        dataset_name = "adsl",
        condition = TRUE,
        set_values_to = exprs(
          AVALC = "MISSING"
        ),
        keep_source_vars = exprs(TRTSDT)
      )
    ),
    set_values_to = exprs(
      PARAMCD = "BOR",
      PARAM = "Best Overall Response"
    )
  )

  expect_dfs_equal(
    base    = expected,
    compare = actual,
    keys    = c("USUBJID", "PARAMCD", "ADT")
  )
})

## Test 4: event-specific mode ----
test_that("derive_extreme_records Test 4: event-specific mode", {
  adhy <- tibble::tribble(
    ~USUBJID, ~AVISITN, ~CRIT1FL,
    "1",             1, "Y",
    "1",             2, "Y",
    "2",             1, "Y",
    "2",             2, NA_character_,
    "2",             3, "Y",
    "2",             4, NA_character_
  ) %>%
    mutate(
      PARAMCD = "ALKPH",
      PARAM = "Alkaline Phosphatase (U/L)"
    )

  actual <- derive_extreme_event(
    adhy,
    by_vars = exprs(USUBJID),
    events = list(
      event(
        condition = is.na(CRIT1FL),
        set_values_to = exprs(AVALC = "N")
      ),
      event(
        condition = CRIT1FL == "Y",
        mode = "last",
        set_values_to = exprs(AVALC = "Y")
      )
    ),
    order = exprs(AVISITN),
    mode = "first",
    keep_source_vars = exprs(AVISITN),
    set_values_to = exprs(
      PARAMCD = "ALK2",
      PARAM = "ALKPH <= 2 times ULN"
    )
  )

  expected <- bind_rows(
    adhy,
    tribble(
      ~USUBJID, ~AVISITN, ~AVALC,
      "1",             2, "Y",
      "2",             2, "N"
    ) %>%
      mutate(
        PARAMCD = "ALK2",
        PARAM = "ALKPH <= 2 times ULN"
      )
  )

  expect_dfs_equal(
    base = expected,
    compare = actual,
    keys = c("USUBJID", "AVISITN", "PARAMCD")
  )
})

## Test 5: event_joined() is handled correctly ----
test_that("derive_extreme_records Test 5: event_joined() is handled correctly", {
  adsl <- tibble::tribble(
    ~USUBJID, ~TRTSDTC,
    "1",      "2020-01-01",
    "2",      "2019-12-12",
    "3",      "2019-11-11",
    "4",      "2019-12-30",
    "5",      "2020-01-01",
    "6",      "2020-02-02",
    "7",      "2020-02-02",
    "8",      "2020-04-01",
    "9",      "2020-02-01"
  ) %>%
    mutate(
      TRTSDT = lubridate::ymd(TRTSDTC),
      STUDYID = "XX1234"
    )

  adrs <- tibble::tribble(
    ~USUBJID, ~ADTC,        ~AVALC,
    "1",      "2020-01-01", "PR",
    "1",      "2020-02-01", "CR",
    "1",      "2020-02-16", "NE",
    "1",      "2020-03-01", "CR",
    "1",      "2020-04-01", "SD",
    "2",      "2020-01-01", "SD",
    "2",      "2020-02-01", "PR",
    "2",      "2020-03-01", "SD",
    "2",      "2020-03-13", "CR",
    "3",      "2019-11-12", "CR",
    "3",      "2019-12-02", "CR",
    "3",      "2020-01-01", "SD",
    "4",      "2020-01-01", "PR",
    "4",      "2020-03-01", "SD",
    "4",      "2020-04-01", "SD",
    "4",      "2020-05-01", "PR",
    "4",      "2020-05-15", "NON-CR/NON-PD",
    "5",      "2020-01-01", "PR",
    "5",      "2020-01-10", "SD",
    "5",      "2020-01-20", "PR",
    "5",      "2020-05-15", "NON-CR/NON-PD",
    "6",      "2020-02-06", "PR",
    "6",      "2020-02-16", "CR",
    "6",      "2020-03-30", "PR",
    "7",      "2020-02-06", "PR",
    "7",      "2020-02-16", "CR",
    "7",      "2020-04-01", "NE",
    "9",      "2020-02-16", "PD"
  ) %>%
    mutate(
      PARAMCD = "OVR",
      ADT = lubridate::ymd(ADTC),
      STUDYID = "XX1234"
    ) %>%
    derive_vars_merged(
      dataset_add = adsl,
      by_vars = exprs(STUDYID, USUBJID),
      new_vars = exprs(TRTSDT)
    )

  actual <-
    derive_extreme_event(
      adrs,
      by_vars = exprs(STUDYID, USUBJID),
      order = exprs(ADT),
      mode = "first",
      source_datasets = list(adsl = adsl),
      events = list(
        event_joined(
          join_vars = exprs(AVALC, ADT),
          join_type = "after",
          first_cond = AVALC.join == "CR" &
            ADT.join >= ADT + 28,
          condition = AVALC == "CR" &
            all(AVALC.join %in% c("CR", "NE")) &
            count_vals(var = AVALC.join, val = "NE") <= 1,
          set_values_to = exprs(
            AVALC = "CR"
          )
        ),
        event_joined(
          join_vars = exprs(AVALC, ADT),
          join_type = "after",
          first_cond = AVALC.join %in% c("CR", "PR") &
            ADT.join >= ADT + 28,
          condition = AVALC == "PR" &
            all(AVALC.join %in% c("CR", "PR", "NE")) &
            count_vals(var = AVALC.join, val = "NE") <= 1 &
            (
              min_cond(
                var = ADT.join,
                cond = AVALC.join == "CR"
              ) > max_cond(var = ADT.join, cond = AVALC.join == "PR") |
                count_vals(var = AVALC.join, val = "CR") == 0 |
                count_vals(var = AVALC.join, val = "PR") == 0
            ),
          set_values_to = exprs(
            AVALC = "PR"
          )
        ),
        event(
          condition = AVALC %in% c("CR", "PR", "SD") & ADT >= TRTSDT + 28,
          set_values_to = exprs(
            AVALC = "SD"
          )
        ),
        event(
          condition = AVALC == "NON-CR/NON-PD" & ADT >= TRTSDT + 28,
          set_values_to = exprs(
            AVALC = "NON-CR/NON-PD"
          )
        ),
        event(
          condition = AVALC == "PD",
          set_values_to = exprs(
            AVALC = "PD"
          )
        ),
        event(
          condition = AVALC %in% c("CR", "PR", "SD", "NON-CR/NON-PD", "NE"),
          set_values_to = exprs(
            AVALC = "NE"
          )
        ),
        event(
          dataset_name = "adsl",
          condition = TRUE,
          set_values_to = exprs(
            AVALC = "MISSING"
          ),
          keep_source_vars = exprs(TRTSDT)
        )
      ),
      set_values_to = exprs(
        PARAMCD = "CBOR",
        PARAM = "Best Confirmed Overall Response by Investigator"
      )
    )

  expected <- bind_rows(
    adrs,
    tibble::tribble(
      ~USUBJID, ~ADTC,         ~AVALC,
      "1",      "2020-02-01",  "CR",
      "2",      "2020-02-01",  "SD",
      "3",      "2020-01-01",  "SD",
      "4",      "2020-03-01",  "SD",
      "5",      "2020-05-15",  "NON-CR/NON-PD",
      "6",      "2020-03-30",  "SD",
      "7",      "2020-02-06",  "NE",
      "8",      NA_character_, "MISSING",
      "9",      "2020-02-16",  "PD"
    ) %>%
      mutate(
        ADT = lubridate::ymd(ADTC),
        STUDYID = "XX1234",
        PARAMCD = "CBOR",
        PARAM = "Best Confirmed Overall Response by Investigator"
      ) %>%
      derive_vars_merged(
        dataset_add = adsl,
        by_vars = exprs(STUDYID, USUBJID),
        new_vars = exprs(TRTSDT)
      )
  )

  expect_dfs_equal(
    base = expected,
    compare = actual,
    keys = c("USUBJID", "PARAMCD", "ADT")
  )
})

## Test 6: ignore_event_order ----
test_that("derive_extreme_records Test 6: ignore_event_order", {
  adrs <- tibble::tribble(
    ~USUBJID, ~AVISITN, ~AVALC,
    "1",             1, "PR",
    "1",             2, "CR",
    "1",             3, "CR"
  ) %>%
    mutate(PARAMCD = "OVR")

  actual <- derive_extreme_event(
    adrs,
    by_vars = exprs(USUBJID),
    order = exprs(AVISITN),
    mode = "first",
    events = list(
      event_joined(
        join_vars = exprs(AVALC),
        join_type = "after",
        first_cond = AVALC.join == "CR",
        condition = AVALC == "CR",
        set_values_to = exprs(AVALC = "Y")
      ),
      event_joined(
        join_vars = exprs(AVALC),
        join_type = "after",
        first_cond = AVALC.join %in% c("CR", "PR"),
        condition = AVALC == "PR",
        set_values_to = exprs(AVALC = "Y")
      )
    ),
    ignore_event_order = TRUE,
    set_values_to = exprs(
      PARAMCD = "CRSP"
    )
  )

  expected <- bind_rows(
    adrs,
    tibble::tribble(
      ~USUBJID, ~AVISITN, ~AVALC, ~PARAMCD,
      "1",             1, "Y",    "CRSP"
    )
  )

  expect_dfs_equal(
    base = expected,
    compare = actual,
    keys = c("USUBJID", "PARAMCD", "AVISITN")
  )
})