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

## Test 1: Test that call_derivation generates expected summary  ----
# ---- call_derivation Test 1:  Test that call_derivation generates expected summary ----
test_that("call_derivation Test 1:  Test that call_derivation generates expected summary", {
  input <- pharmaversesdtm::vs[sample(seq_len(nrow(pharmaversesdtm::vs)), 1000), ]

  expected_output <- input %>%
    derive_summary_records(
      by_vars = exprs(USUBJID, VSTESTCD),
      analysis_var = VSSTRESN,
      summary_fun = function(x) mean(x, na.rm = TRUE),
      set_values_to = exprs(DTYPE = "AVERAGE"),
      filter = dplyr::n() >= 2L
    ) %>%
    derive_summary_records(
      by_vars = exprs(USUBJID, VSTESTCD),
      analysis_var = VSSTRESN,
      summary_fun = function(x) max(x, na.rm = TRUE),
      set_values_to = exprs(DTYPE = "MAXIMUM"),
      filter = dplyr::n() >= 2L
    ) %>%
    derive_summary_records(
      by_vars = exprs(USUBJID, VSTESTCD),
      analysis_var = VSSTRESN,
      summary_fun = function(x) min(x, na.rm = TRUE),
      set_values_to = exprs(DTYPE = "MINIMUM"),
      filter = dplyr::n() >= 2L
    )

  actual_output <- call_derivation(
    dataset = input,
    derivation = derive_summary_records,
    variable_params = list(
      params(
        summary_fun = function(x) mean(x, na.rm = TRUE),
        set_values_to = exprs(DTYPE = "AVERAGE")
      ),
      params(
        summary_fun = function(x) max(x, na.rm = TRUE),
        set_values_to = exprs(DTYPE = "MAXIMUM")
      ),
      params(
        summary_fun = function(x) min(x, na.rm = TRUE),
        set_values_to = exprs(DTYPE = "MINIMUM")
      )
    ),
    by_vars = exprs(USUBJID, VSTESTCD),
    analysis_var = VSSTRESN,
    filter = dplyr::n() >= 2L
  )

  expect_dfs_equal(
    expected_output,
    actual_output,
    keys = c("USUBJID", "VSTESTCD", "VISIT", "DTYPE", "VSSEQ")
  )
})

## Test 2: Test that call_derivation generates expected imputation  ----
# ---- call_derivation Test 2: Test that call_derivation generates expected imputation ----
test_that("call_derivation Test 2: Test that call_derivation generates expected imputation", {
  input <- pharmaversesdtm::ae[sample(seq_len(nrow(pharmaversesdtm::ae)), 1000), ] %>%
    left_join(admiral_adsl, by = "USUBJID")

  expected_output <- input %>%
    derive_vars_dt(
      new_vars_prefix = "AST",
      dtc = AESTDTC,
      date_imputation = "first",
      min_dates = exprs(TRTSDT),
      max_dates = exprs(TRTEDT)
    ) %>%
    derive_vars_dt(
      new_vars_prefix = "AEN",
      dtc = AEENDTC,
      date_imputation = "last",
      min_dates = exprs(TRTSDT),
      max_dates = exprs(TRTEDT)
    )

  actual_output <- call_derivation(
    dataset = input,
    derivation = derive_vars_dt,
    variable_params = list(
      params(dtc = AESTDTC, date_imputation = "first", new_vars_prefix = "AST"),
      params(dtc = AEENDTC, date_imputation = "last", new_vars_prefix = "AEN")
    ),
    min_dates = exprs(TRTSDT),
    max_dates = exprs(TRTEDT)
  )

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

## Test 3: Test that Error is thrown if ... has no arguments  ----
# ---- call_derivation Test 3: Test that Error is thrown if ... has no arguments ----
test_that("call_derivation Test 3: Test that Error is thrown if ... has no arguments", {
  input <- pharmaversesdtm::ae[sample(seq_len(nrow(pharmaversesdtm::ae)), 1000), ] %>%
    left_join(admiral_adsl, by = "USUBJID")

  expect_error(
    call_derivation(
      dataset = input,
      derivation = derive_vars_dt,
      variable_params = list(
        params(dtc = AESTDTC, date_imputation = "first", new_vars_prefix = "AST"),
        params(dtc = AEENDTC, date_imputation = "last", new_vars_prefix = "AEN")
      )
    ), "At least one argument must be set inside `...`"
  )
})

## Test 4: Error is thrown if ... arguments are not properly named ----
# ---- call_derivation Test 4: Error is thrown if ... arguments are not properly named ----
test_that("call_derivation Test 4: Error is thrown if ... arguments are not properly named", {
  input <- pharmaversesdtm::ae[sample(seq_len(nrow(pharmaversesdtm::ae)), 1000), ] %>%
    left_join(admiral_adsl, by = "USUBJID")

  expect_error(
    call_derivation(
      dataset = input,
      derivation = derive_vars_dt,
      variable_params = list(
        params(dtc = AESTDTC, date_imputation = "first", new_vars_prefix = "AST"),
        params(dtc = AEENDTC, date_imputation = "last", new_vars_prefix = "AEN")
      ),
      XYZSDT,
      XYZEDT
    )
  )
})

## Test 5: Error is thrown params is empty ----
# ---- call_derivation Test 5: Error is thrown params is empty ----
test_that("call_derivation Test 5: Error is thrown params is empty", {
  input <- pharmaversesdtm::ae[sample(seq_len(nrow(pharmaversesdtm::ae)), 1000), ] %>%
    left_join(admiral_adsl, by = "USUBJID")

  expect_error(
    call_derivation(
      dataset = input,
      derivation = derive_vars_dt,
      variable_params = list(
        params(),
        params()
      ),
      min_dates = exprs(TRTSDT),
      max_dates = exprs(TRTEDT)
    ), "At least one argument must be provided"
  )
})

## Test 6: Error is thrown if passed params are not properly named ----
# ---- call_derivation Test 6: Error is thrown if passed params are not properly named ----
test_that("call_derivation Test 6: Error is thrown if passed params are not properly named", {
  input <- pharmaversesdtm::ae[sample(seq_len(nrow(pharmaversesdtm::ae)), 1000), ] %>%
    left_join(admiral_adsl, by = "USUBJID")

  expect_error(
    call_derivation(
      dataset = input,
      derivation = derive_vars_dt,
      variable_params = list(
        params(XYZ),
        params(XYZ)
      ),
      min_dates = exprs(TRTSDT),
      max_dates = exprs(TRTEDT)
    ), "All arguments passed to `params()` must be named",
    fixed = TRUE
  )
})

## Test 7: Error is thrown if `...` arguments are not properly named ----
# ---- call_derivation Test 7: Error is thrown if `...` arguments are not properly named ----
test_that("call_derivation Test 7: Error is thrown if `...` arguments are not properly named", {
  input <- pharmaversesdtm::ae[sample(seq_len(nrow(pharmaversesdtm::ae)), 1000), ] %>%
    left_join(admiral_adsl, by = "USUBJID")

  expect_error(
    call_derivation(
      dataset = input,
      derivation = derive_vars_dt,
      variable_params = list(
        params(dtc = AESTDTC, date_imputation = "first", new_vars_prefix = "AST"),
        params(dtc = AEENDTC, date_imputation = "last", new_vars_prefix = "AEN")
      ),
      XYZSDT,
      XYZEDT
    )
  )
})

## Test 8: Error is thrown if duplicate parameters ----
# ---- call_derivation Test 8: Error is thrown if duplicate parameters ----
test_that("call_derivation Test 8: Error is thrown if duplicate parameters", {
  expect_error(
    params(dtc = VSDTC, dtc = VSDTC, new_vars_prefix = "A"),
    "The following parameters have been specified more than once: `dtc`",
    fixed = TRUE
  )
})