tests/testthat/test-derive_joined.R

In admiral: ADaM in R Asset Library

# derive_vars_joined ----
## Test 1: no by_vars, no order, no new_vars ----
test_that("derive_vars_joined Test 1: no by_vars, no order, no new_vars", {
  expected <- tibble::tribble(
    ~USUBJID, ~ADY, ~AVISIT,    ~AWLO, ~AWHI,
    "1",        -2, "BASELINE",   -30,     1,
    "1",         3, "WEEK 1",       2,     7,
    "1",        24, "WEEK 4",      23,    30,
    "2",        NA, NA,            NA,    NA
  )

  windows <- tibble::tribble(
    ~AVISIT,    ~AWLO, ~AWHI,
    "BASELINE",   -30,     1,
    "WEEK 1",       2,     7,
    "WEEK 2",       8,    15,
    "WEEK 3",      16,    22,
    "WEEK 4",      23,    30
  )

  expect_dfs_equal(
    base = expected,
    comp = derive_vars_joined(
      select(expected, USUBJID, ADY),
      dataset_add = windows,
      join_vars = exprs(AWHI, AWLO),
      filter_join = AWLO <= ADY & ADY <= AWHI
    ),
    keys = c("USUBJID", "ADY")
  )
})

## Test 2: new_vars with rename ----
test_that("derive_vars_joined Test 2: new_vars with rename", {
  expected <- tibble::tribble(
    ~USUBJID, ~ADY, ~AVAL, ~NADIR,
    "1",        -7,    10,     NA,
    "1",         1,    12,     NA,
    "1",         8,    11,     12,
    "1",        15,     9,     11,
    "1",        20,    14,      9,
    "1",        24,    12,      9,
    "2",        13,     8,     NA
  )

  adbds <- select(expected, -NADIR)

  expect_dfs_equal(
    base = expected,
    comp = derive_vars_joined(
      adbds,
      dataset_add = adbds,
      by_vars = exprs(USUBJID),
      order = exprs(AVAL),
      new_vars = exprs(NADIR = AVAL),
      join_vars = exprs(ADY),
      filter_add = ADY > 0,
      filter_join = ADY.join < ADY,
      mode = "first",
      check_type = "none"
    ),
    keys = c("USUBJID", "ADY")
  )
})

## Test 3: by_vars with rename ----
test_that("derive_vars_joined Test 3: by_vars with rename", {
  adae <- tibble::tribble(
    ~AEGRPID,
    "1",
    "2"
  ) %>%
    mutate(
      TRTSDTM = ymd_hms("2020-01-06T12:00:00")
    )

  faae <- tibble::tribble(
    ~FAGRPID, ~FADT,        ~FAORRES,
    "1",      "2020-01-01", "1",
    "1",      "2020-01-03", "2",
    "1",      "2020-01-05", "3",
    "1",      "2020-01-08", "4"
  ) %>%
    mutate(FADT = ymd(FADT))
  expect_dfs_equal(
    base = mutate(adae, ATOXGR_pre = c("3", NA)),
    comp = derive_vars_joined(
      adae,
      dataset_add = faae,
      by_vars = exprs(AEGRPID = FAGRPID),
      order = exprs(FADT),
      new_vars = exprs(ATOXGR_pre = FAORRES),
      join_vars = exprs(FADT),
      filter_join = FADT < TRTSDTM,
      mode = "last"
    ),
    keys = c("AEGRPID")
  )
})

## Test 4: order with expression ----
test_that("derive_vars_joined Test 4: order with expression", {
  adae <- tibble::tribble(
    ~AEGRPID,
    "1",
    "2"
  ) %>%
    mutate(
      TRTSDTM = ymd_hms("2020-01-06T12:00:00")
    )

  faae <- tibble::tribble(
    ~FAGRPID, ~FADTC,       ~FAORRES,
    "1",      "2020-01-01", "1",
    "1",      "2020-01-03", "2",
    "1",      "2020-01-05", "3",
    "1",      "2020-01-08", "4"
  )
  expect_dfs_equal(
    base = mutate(adae, ATOXGR_pre = c("3", NA)),
    comp = derive_vars_joined(
      adae,
      dataset_add = faae,
      by_vars = exprs(AEGRPID = FAGRPID),
      order = exprs(FADT = convert_dtc_to_dt(FADTC)),
      new_vars = exprs(ATOXGR_pre = FAORRES),
      join_vars = exprs(FADT),
      filter_join = FADT < TRTSDTM,
      mode = "last"
    ),
    keys = c("AEGRPID")
  )
})

## Test 5: join_vars with expression ----
test_that("derive_vars_joined Test 5: join_vars with expression", {
  add <- tibble::tribble(
    ~USUBJID, ~TRDTC,       ~TRSTRESN,
    "1",      "2020-02-01",        10,
    "1",      "2020-02-04",        12,
    "1",      "2020-02-08",        11,
    "1",      "2020-02-13",         9,
    "1",      "2020-02-24",        14,
    "1",      "2020-03-01",        12,
    "2",      "2021-01-13",         8
  )

  expected <- tibble::tribble(
    ~USUBJID, ~ADT,         ~AVAL,
    "1",      "2020-02-09",    10,
    "1",      "2020-02-13",     9,
    "1",      "2020-02-24",     9,
    "1",      "2020-03-01",     9,
    "2",      "2021-01-13",     8
  ) %>%
    mutate(
      ADT = ymd(ADT)
    )

  expect_dfs_equal(
    base = expected,
    comp = derive_vars_joined(
      select(expected, -AVAL),
      dataset_add = add,
      by_vars = exprs(USUBJID),
      order = exprs(TRSTRESN),
      new_vars = exprs(AVAL = TRSTRESN),
      join_vars = exprs(TRDT = convert_dtc_to_dt(TRDTC)),
      filter_join = TRDT <= ADT,
      mode = "first",
      check_type = "none"
    ),
    keys = c("USUBJID", "ADT")
  )
})


## Test 6: no join_vars, no filter_join ----
test_that("derive_vars_joined Test 6: no join_vars, no filter_join", {
  adae <- tibble::tribble(
    ~AEGRPID,
    "1",
    "2"
  ) %>%
    mutate(
      TRTSDTM = ymd_hms("2020-01-06T12:00:00")
    )

  faae <- tibble::tribble(
    ~FAGRPID, ~FADT,        ~FAORRES,
    "1",      "2020-01-01", "1",
    "1",      "2020-01-03", "2",
    "1",      "2020-01-05", "3",
    "1",      "2020-01-08", "4"
  ) %>%
    mutate(FADT = ymd(FADT))
  expect_dfs_equal(
    base = mutate(adae, ATOXGR_pre = c("1", NA)),
    comp = derive_vars_joined(
      adae,
      dataset_add = faae,
      by_vars = exprs(AEGRPID = FAGRPID),
      order = exprs(FAORRES),
      new_vars = exprs(ATOXGR_pre = FAORRES),
      mode = "first"
    ),
    keys = c("AEGRPID")
  )
})

## Test 7: new_vars expressions using variables from both datasets ----
test_that("derive_vars_joined Test 7: new_vars expressions using variables from both datasets", {
  expected <- tibble::tribble(
    ~USUBJID, ~ASTDT,       ~AESEQ, ~LSTDSDUR,
    "1",      "2020-02-02",      1,        14,
    "1",      "2020-02-04",      2,         2
  ) %>%
    mutate(ASTDT = ymd(ASTDT))

  ex <- tibble::tribble(
    ~USUBJID, ~EXSDTC,
    "1",      "2020-01-10",
    "1",      "2020-01",
    "1",      "2020-01-20",
    "1",      "2020-02-03"
  )

  expect_dfs_equal(
    base = expected,
    compare = derive_vars_joined(
      select(expected, -LSTDSDUR),
      dataset_add = ex,
      by_vars = exprs(USUBJID),
      order = exprs(EXSDT = convert_dtc_to_dt(EXSDTC)),
      new_vars = exprs(LSTDSDUR = compute_duration(
        start_date = EXSDT, end_date = ASTDT
      )),
      filter_add = !is.na(EXSDT),
      filter_join = EXSDT <= ASTDT,
      mode = "last"
    ),
    keys = c("USUBJID", "AESEQ")
  )
})

## Test 8: error if new_vars are already in dataset ----
test_that("derive_vars_joined Test 8: error if new_vars are already in dataset", {
  myd <- data.frame(day = c(1, 2, 3), val = c(0, 17, 21))
  expect_error(
    derive_vars_joined(
      myd,
      dataset_add = myd,
      order = exprs(day),
      mode = "last",
      filter_join = day < day.join
    ),
    regexp = paste(
      "The following columns in `dataset_add` have naming conflicts with `dataset`"
    )
  )
})

## Test 9: fixing a bug from issue 1966 ----
test_that("derive_vars_joined Test 9: fixing a bug from issue 1966", { # nolint
  adlb_ast <- tribble(
    ~ADT,         ~ASEQ,
    "2002-01-01", 1,
    "2002-02-02", 2,
    "2002-02-02", 3
  ) %>%
    mutate(
      STUDYID = "ABC",
      USUBJID = "1",
      ADT = ymd(ADT),
      ADTM = as_datetime(ADT)
    )

  adlb_tbili_pbl <- tribble(
    ~ADT,         ~ASEQ,
    "2002-01-01", 4,
    "2002-02-02", 5,
    "2002-02-02", 6
  ) %>%
    mutate(
      STUDYID = "ABC",
      USUBJID = "1",
      ADT = ymd(ADT),
      ADTM = as_datetime(ADT)
    )

  adlb_joined <- derive_vars_joined(
    adlb_ast,
    dataset_add = adlb_tbili_pbl,
    by_vars = exprs(STUDYID, USUBJID),
    order = exprs(ADTM, ASEQ),
    new_vars = exprs(TBILI_ADT = ADT),
    filter_join = ADT <= ADT.join,
    mode = "first"
  )

  expected <- adlb_ast %>%
    mutate(TBILI_ADT = as.Date(c("2002-01-01", "2002-02-02", "2002-02-02"), "%Y-%m-%d"))

  expect_dfs_equal(
    base = expected,
    compare = adlb_joined,
    keys = c("ADT", "ASEQ", "STUDYID", "USUBJID", "ADTM", "TBILI_ADT")
  )
})

## Test 10: order vars are selected properly in function body ----
test_that("derive_vars_joined Test 10: order vars are selected properly in function body", {
  myd <- data.frame(day = c(1, 2, 3), val = c(0, 17, 21))
  actual <- derive_vars_joined(
    myd,
    dataset_add = myd,
    new_vars = exprs(first_val = val),
    join_vars = exprs(day),
    order = exprs(-day),
    mode = "last",
    filter_join = day < day.join
  )
  expected <- tribble(
    ~day, ~val, ~first_val,
    1,       0,         17,
    2,      17,         21,
    3,      21,         NA
  )

  expect_dfs_equal(
    base = expected,
    compare = actual,
    keys = c("day", "val", "first_val")
  )
})