tests/testthat/test-lbt14.R

In chevron: Standard TLGs for Clinical Trials Reporting

# lbt14 functions ----

syn_lab <- syn_data[c("adsl", "adlb")]
syn_lab$adlb <- syn_lab$adlb[syn_data$adlb$PARAMCD == "ALT", ]


test_that("lbt14 functions with default argument value return expected result with test data", {
  pre_data <- lbt14_pre(syn_lab)
  raw_res <- lbt14_main(pre_data)
  res <- lbt14_post(raw_res)
  expect_snapshot(cat(export_as_txt(res, lpp = 100)))
})

test_that("lbt14 functions with default argument value return expected result with test data when direction = high", {
  skip_on_os("windows")
  pre_data <- lbt14_pre(syn_lab, direction = "high")
  raw_res <- lbt14_main(pre_data, direction = "high")
  res <- lbt14_post(raw_res, direction = "high")
  expect_snapshot(cat(export_as_txt(res, lpp = 100)))
})

test_that("lbt14 functions with `gr_missing = excl` return expected result with test data", {
  skip_on_os("windows")
  pre_data <- lbt14_pre(syn_lab, gr_missing = "excl")
  raw_res <- lbt14_main(pre_data)
  res <- lbt14_post(raw_res)
  expect_snapshot(cat(export_as_txt(res, lpp = 100)))
})

test_that("lbt14 functions with `gr_missing = gr_0` return expected result with test data", {
  skip_on_os("windows")
  pre_data <- lbt14_pre(syn_lab, gr_missing = "gr_0")
  raw_res <- lbt14_main(pre_data)
  res <- lbt14_post(raw_res)
  expect_snapshot(cat(export_as_txt(res, lpp = 100)))
})

# lbt14 ----
test_that("lbt14 can handle all NA values", {
  skip_on_os("windows")
  proc_data <- syn_lab
  proc_data$adlb <- proc_data$adlb %>%
    mutate(
      BTOXGR = NA_character_,
      ATOXGR = NA_character_
    )

  res <- expect_silent(run(lbt14, proc_data))
  expect_snapshot(cat(export_as_txt(res, lpp = 100)))
})

test_that("lbt14 can handle some NA values", {
  skip_on_os("windows")
  set.seed(1)
  new_btoxgr <- syn_lab$adlb$BTOXGR
  new_btoxgr[sample(seq_along(new_btoxgr), 20)] <- NA
  new_atoxgr <- syn_lab$adlb$ATOXGR
  new_atoxgr[sample(seq_along(new_atoxgr), 20)] <- NA

  proc_data <- syn_lab

  proc_data$adlb <- proc_data$adlb %>%
    mutate(
      BTOXGR = factor(.env$new_btoxgr),
      ATOXGR = factor(.env$new_atoxgr)
    )

  res <- expect_silent(run(lbt14, proc_data))
  expect_snapshot(cat(export_as_txt(res, lpp = 100)))
})

test_that("lbt14 can accept different gr_missing", {
  skip_on_os("windows")
  res1 <- run(lbt14, syn_lab, gr_missing = "incl")
  res2 <- run(lbt14, syn_lab, gr_missing = "excl")
  res3 <- run(lbt14, syn_lab, gr_missing = "gr_0")
  expect_snapshot(cat(export_as_txt(res1, lpp = 100)))
  expect_snapshot(cat(export_as_txt(res2, lpp = 100)))
  expect_snapshot(cat(export_as_txt(res3, lpp = 100)))
})

test_that("lbt14 fails on incomlete data", {
  skip_on_os("windows")
  proc_data <- syn_lab

  proc_data$adlb <- proc_data$adlb %>%
    mutate(ATOXGR = NULL)

  expect_error(run(lbt14, proc_data))
})

# lbt14 direction = "high" ----
test_that("lbt14 can handle all NA values with direction = high", {
  skip_on_os("windows")
  proc_data <- syn_lab

  proc_data$adlb <- proc_data$adlb %>%
    mutate(
      BTOXGR = factor(NA),
      ATOXGR = factor(NA)
    )

  res <- expect_silent(run(lbt14, proc_data, direction = "high"))
  expect_snapshot(cat(export_as_txt(res, lpp = 100)))
})

test_that("lbt14 can handle some NA values with direction = high", {
  skip_on_os("windows")
  set.seed(1)
  new_btoxgr <- syn_lab$adlb$BTOXGR
  new_btoxgr[sample(seq_along(new_btoxgr), 20)] <- NA
  new_atoxgr <- syn_lab$adlb$ATOXGR
  new_atoxgr[sample(seq_along(new_atoxgr), 20)] <- NA

  proc_data <- syn_lab

  proc_data$adlb <- proc_data$adlb %>%
    mutate(
      BTOXGR = factor(.env$new_btoxgr),
      ATOXGR = factor(.env$new_atoxgr)
    )

  res <- expect_silent(run(lbt14, proc_data, direction = "high"))
  expect_snapshot(cat(export_as_txt(res, lpp = 100)))
})

test_that("lbt14 can accept different gr_missing with direction = high", {
  skip_on_os("windows")
  proc_data <- syn_lab
  res1 <- run(lbt14, proc_data, gr_missing = "incl", direction = "high")
  res2 <- run(lbt14, proc_data, gr_missing = "excl", direction = "high")
  res3 <- run(lbt14, proc_data, gr_missing = "gr_0", direction = "high")
  expect_snapshot(cat(export_as_txt(res1, lpp = 100)))
  expect_snapshot(cat(export_as_txt(res2, lpp = 100)))
  expect_snapshot(cat(export_as_txt(res3, lpp = 100)))
})

test_that("lbt14 fails on incomlete data", {
  skip_on_os("windows")
  proc_data <- syn_lab

  proc_data$adlb <- proc_data$adlb %>%
    mutate(ATOXGR = NULL)

  expect_error(run(lbt14, proc_data, direction = "high"))
})