tests/testthat/test-independent_as_gt.R

In gsDesign2: Group Sequential Design with Non-Constant Effect

gt_to_latex <- function(data) cat(as.character(gt::as_latex(data)))

test_that("enroll_rate produces the expected output", {
  expected_result <- tibble::tibble(stratum = "All", duration = 18, rate = 20)

  result <- define_enroll_rate(duration = 18, rate = 20)

  expect_identical(as.data.frame(result), as.data.frame(expected_result))
})

test_that("fail_rate produces the expected output", {
  expected_result <- tibble::tibble(
    stratum = "All",
    duration = c(4, 100),
    fail_rate = 0.0578,
    dropout_rate = 0.001,
    hr = c(1, 0.6)
  )
  result <- define_fail_rate(
    duration = c(4, 100),
    fail_rate = log(2) / 12,
    dropout_rate = 0.001,
    hr = c(1, 0.6)
  )

  expect_equal(result$stratum, expected_result$stratum)
  expect_equal(result$duration, expected_result$duration)
  # Check if the fail_rate values are within a tolerance
  expect_true(all(abs(result$fail_rate - expected_result$fail_rate) < 1e-4))
  expect_equal(result$dropout_rate, expected_result$dropout_rate)
  expect_equal(result$hr, expected_result$hr)
})

test_that("Snapshot test for fixed_design summary as_gt", {
  skip_on_cran()

  enroll_rate <- define_enroll_rate(duration = 18, rate = 20)
  fail_rate <- define_fail_rate(
    duration = c(4, 100),
    fail_rate = log(2) / 12,
    dropout_rate = .001, hr = c(1, .6)
  )

  output <- fixed_design_ahr(
    alpha = 0.025,
    power = 1 - 0.1,
    enroll_rate = enroll_rate,
    fail_rate = fail_rate,
    study_duration = 36,
    ratio = 1
  ) %>%
    summary() %>%
    as_gt()

  local_edition(3)
  expect_snapshot_output(gt_to_latex(output))
})

test_that("Snapshot test for fixed_design summary as_gt with custom title and footnote", {
  skip_on_cran()

  enroll_rate <- define_enroll_rate(duration = 18, rate = 20)
  fail_rate <- define_fail_rate(
    duration = c(4, 100),
    fail_rate = log(2) / 12,
    dropout_rate = .001, hr = c(1, .6)
  )

  output <- fixed_design_ahr(
    alpha = 0.025,
    power = 1 - 0.1,
    enroll_rate = enroll_rate,
    fail_rate = fail_rate,
    study_duration = 36,
    ratio = 1
  ) %>%
    summary() %>%
    as_gt(title = "Custom Title", footnote = "Custom footnote.")

  local_edition(3)
  expect_snapshot_output(gt_to_latex(output))
})

test_that("Snapshot test for fixed_design_fh summary as_gt", {
  skip_on_cran()

  enroll_rate <- define_enroll_rate(
    duration = 18,
    rate = 20
  )
  fail_rate <- define_fail_rate(
    duration = c(4, 100),
    fail_rate = log(2) / 12,
    dropout_rate = .001,
    hr = c(1, .6)
  )

  output <- fixed_design_fh(
    alpha = 0.025,
    power = 1 - 0.1,
    enroll_rate = enroll_rate,
    fail_rate = fail_rate,
    study_duration = 36,
    ratio = 1
  ) %>%
    summary() %>%
    as_gt()

  local_edition(3)
  expect_snapshot_output(gt_to_latex(output))
})

test_that("Snapshot test for gs_design_ahr summary as_gt", {
  skip_on_cran()

  output <- gs_design_ahr() %>%
    summary() %>%
    as_gt()

  local_edition(3)
  expect_snapshot_output(gt_to_latex(output))
})

test_that("Snapshot test for gs_power_ahr summary as_gt", {
  skip_on_cran()

  output <- gs_power_ahr(lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.1)) %>%
    summary() %>%
    as_gt()

  local_edition(3)
  expect_snapshot_output(gt_to_latex(output))
})

test_that("Snapshot test for gs_design_wlr summary as_gt", {
  skip_on_cran()

  output <- gs_design_wlr() %>%
    summary() %>%
    as_gt()

  local_edition(3)
  expect_snapshot_output(gt_to_latex(output))
})

test_that("Snapshot test for gs_power_wlr summary as_gt", {
  skip_on_cran()

  output <- gs_power_wlr(lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.1)) %>%
    summary() %>%
    as_gt(
      footnote = list(
        content = c(
          "approximate weighted hazard ratio to cross bound.",
          "wAHR is the weighted AHR.",
          "the crossing probability.",
          "this table is generated by gs_power_wlr."
        ),
        location = c("~wHR at bound", NA, NA, NA),
        attr = c("colname", "analysis", "spanner", "title")
      )
    )

  local_edition(3)
  expect_snapshot_output(gt_to_latex(output))
})

test_that("Snapshot test for gs_power_combo summary as_gt", {
  skip_on_cran()

  with_seed <- function(seed, code) {
    code <- substitute(code)
    original_seed <- .Random.seed
    on.exit(.Random.seed <<- original_seed)
    set.seed(seed)
    eval.parent(code)
  }

  # See <https://github.com/Merck/gsDesign2/issues/340>
  output <- with_seed(
    42,
    {
      gs_power_combo() %>%
        summary() %>%
        as_gt()
    }
  )

  local_edition(3)
  expect_snapshot_output(gt_to_latex(output))
})

test_that("Snapshot test for gs_design_rd summary as_gt", {
  skip_on_cran()

  output <- gs_design_rd() %>%
    summary() %>%
    as_gt()

  local_edition(3)
  expect_snapshot_output(gt_to_latex(output))
})

test_that("Snapshot test for gs_power_rd summary as_gt", {
  skip_on_cran()

  output <- gs_power_rd() %>%
    summary() %>%
    as_gt()

  local_edition(3)
  expect_snapshot_output(gt_to_latex(output))
})

test_that("Snapshot test for gs_power_wlr summary as_gt with custom title and subtitle", {
  skip_on_cran()

  output <- gs_power_wlr(lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.1)) %>%
    summary() %>%
    as_gt(title = "Bound Summary", subtitle = "from gs_power_wlr")

  local_edition(3)
  expect_snapshot_output(gt_to_latex(output))
})

test_that("Snapshot test for gs_power_wlr summary as_gt with colname_spanner and colname_spannersub", {
  skip_on_cran()

  output <- gs_power_wlr(lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.1)) %>%
    summary() %>%
    as_gt(
      colname_spanner = "Cumulative probability to cross boundaries",
      colname_spannersub = c("under H1", "under H0")
    ) %>%
    suppressWarnings() # Can be removed after <https://github.com/Merck/gsDesign2/issues/339> is fixed

  local_edition(3)
  expect_snapshot_output(gt_to_latex(output))
})

test_that("Snapshot test for gs_power_wlr summary as_gt with custom footnotes", {
  skip_on_cran()

  output <- gs_power_wlr(lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.1)) %>%
    summary() %>%
    as_gt(
      footnote = list(
        content = c(
          "approximate weighted hazard ratio to cross bound.",
          "wAHR is the weighted AHR.",
          "the crossing probability.",
          "this table is generated by gs_power_wlr."
        ),
        location = c("~wHR at bound", NA, NA, NA),
        attr = c("colname", "analysis", "spanner", "title")
      )
    )

  local_edition(3)
  expect_snapshot_output(gt_to_latex(output))
})

test_that("Snapshot test for gs_power_wlr summary as_gt with display_bound", {
  skip_on_cran()

  output <- gs_power_wlr(lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.1)) %>%
    summary() %>%
    as_gt(display_bound = "Efficacy")

  local_edition(3)
  expect_snapshot_output(gt_to_latex(output))
})

test_that("Snapshot test for gs_power_wlr summary as_gt with display_columns", {
  skip_on_cran()

  output <- gs_power_wlr(lpar = list(sf = gsDesign::sfLDOF, total_spend = 0.1)) %>%
    summary() %>%
    as_gt(display_columns = c("Analysis", "Bound", "Nominal p", "Z", "Probability"))

  local_edition(3)
  expect_snapshot_output(gt_to_latex(output))
})