tests/testthat/test-developer-summary.R

In gsDesign2: Group Sequential Design with Non-Constant Effect

# See helper functions in helper-developer-summary.R

# Maintain previous behavior
test_that("summary.gs_design() accepts same-length vectors for analysis_vars and analysis_decimals", {
  x <- gs_design_ahr(analysis_time = c(12, 24))

  # default decimals
  observed <- x |>
    summary() |>
    attr("groups") |>
    extract_summary_analysis()
  expect_identical(
    observed,
    paste0("Analysis: 1 Time: 12 N: 707.3 Events: 160.4 AHR: 0.81 Information fraction: ", round(x$analysis$event[1]/ max(x$analysis$event), 2))
  )

  # specify the decimals for each variable
  observed <- x |>
    summary(
      analysis_vars = c("time", "n", "event", "ahr", "info_frac"),
      analysis_decimals = c(2, 0, 0, 4, 4)
    ) |>
    attr("groups") |>
    extract_summary_analysis()
  expect_identical(
    observed,
    "Analysis: 1 Time: 12 N: 707 Events: 160 AHR: 0.8108 Information fraction: 0.4191"
  )

  # Drop variables and also specify the decimals
  observed <- x |>
    summary(
      analysis_vars = c("ahr", "info_frac"),
      analysis_decimals = c(4, 4)
    ) |>
    attr("groups") |>
    extract_summary_analysis()
  expect_identical(
    observed,
    "Analysis: 1 AHR: 0.8108 Information fraction: 0.4191"
  )

  # Rearrange variables
  observed <- x |>
    summary(
      analysis_vars = c("info_frac", "ahr", "event", "n", "time"),
      analysis_decimals = c(4, 4, 0, 0, 2)
    ) |>
    attr("groups") |>
    extract_summary_analysis()
  expect_identical(
    observed,
    "Analysis: 1 Information fraction: 0.4191 AHR: 0.8108 Events: 160 N: 707 Time: 12"
  )

  # Throw error if unnamed analysis_decimals does not match length of analysis_vars
  expect_error(
    summary(
      x,
      analysis_vars = c("info_frac", "ahr", "event", "n", "time"),
      analysis_decimals = c(4, 4),
    ),
    "'analysis_vars' and 'analysis_decimals' must be of the same length"
  )
})

test_that("summary.gs_design() accepts a named vector for analysis_decimals", {
  x <- gs_design_ahr(analysis_time = c(12, 24))

  # Specify decimals
  observed <- x |>
    summary(analysis_decimals = c(ahr = 4, info_frac0 = 4)) |>
    attr("groups") |>
    extract_summary_analysis()
  expect_identical(
    observed,
    paste0("Analysis: 1 Time: 12 N: 707.3 Events: 160.4 AHR: 0.8108 Information fraction: ", round(x$analysis$event[1]/ max(x$analysis$event), 4))
  )

  # Specify decimals and also drop some variables
  observed <- x |>
    summary(
      analysis_vars = c("event", "ahr", "info_frac0"),
      analysis_decimals = c(ahr = 4, info_frac0 = 4)
    ) |>
    attr("groups") |>
    extract_summary_analysis()
  expect_identical(
    observed,
    paste0("Analysis: 1 Events: 160.4 AHR: 0.8108 Information fraction: ", round(x$analysis$event[1]/max(x$analysis$event), 4))
  )

  # Specify decimals and rearrange some variables
  observed <- x |>
    summary(
      analysis_vars = c("info_frac0", "ahr", "event"),
      analysis_decimals = c(ahr = 4, info_frac0 = 4)
    ) |>
    attr("groups") |>
    extract_summary_analysis()
  expect_identical(
    observed,
    paste0("Analysis: 1 Information fraction: ", round(x$analysis$event[1]/max(x$analysis$event), 4), " AHR: 0.8108 Events: 160.4")
  )

  # Only drop variables
  observed <- x |>
    summary(
      analysis_vars = c("info_frac0", "ahr", "event")
    ) |>
    attr("groups") |>
    extract_summary_analysis()
  expect_identical(
    observed,
    "Analysis: 1 Information fraction: 0.42 AHR: 0.81 Events: 160.4"
  )

  # Throw error is analysis_decimals is unnamed
  expect_error(
    summary(x, analysis_decimals = c(4, 4)),
    "'analysis_decimals' must be a named vector if 'analysis_vars' is not provided"
  )
})

test_that("The column 'Bound' is always included in summary.gs_design() output", {
  x <- gs_design_ahr()

  # without col_vars
  observed <- summary(x)
  expect_true("Bound" %in% colnames(observed))

  # including "bound" in col_vars
  observed <- summary(
    x,
    col_vars = c(
      "bound", "z", "~hr at bound", "nominal p", "Alternate hypothesis", "Null hypothesis"
    ),
    col_decimals = c(NA, 4, 4, 4, 4, 4)
  )
  expect_true("Bound" %in% colnames(observed))

  # excluding "bound" in col_vars
  observed <- summary(
    x,
    col_vars = c(
      "z", "~hr at bound", "nominal p", "Alternate hypothesis", "Null hypothesis"
    ),
    col_decimals = c(4, 4, 4, 4, 4)
  )
  expect_true("Bound" %in% colnames(observed))
})

test_that("The full alpha is correctly carried over", {
  a_level <- 0.02
  x <- gs_power_ahr(
    upper = gs_spending_bound,
    upar = list(
      sf = gsDesign::sfLDOF,
      total_spend = a_level
    ),
    test_lower = FALSE
  )

  # without col_vars
  observed <- summary(x)

  expect_equal(attributes(observed)$full_alpha, a_level)
})

# Maintain previous behavior
test_that("summary.gs_design() accepts same-length vectors for col_vars and col_decimals", {
  x <- gs_design_ahr()

  # default decimals
  x_sum <- summary(x)
  observed <- as.data.frame(x_sum)[, -1:-2]
  expected <- data.frame(
    Z = 1.96,
    `~HR at bound` = 0.795,
    `Nominal p` = 0.025,
    `Alternate hypothesis` = 0.9,
    `Null hypothesis` = 0.025,
    check.names = FALSE
  )
  expect_equal(observed, expected)

  # specify the decimals for each variable
  x_sum <- summary(
    x,
    col_vars = c("z", "~hr at bound", "nominal p", "Alternate hypothesis", "Null hypothesis"),
    col_decimals = c(0, 0, 0, 0, 0)
  )
  observed <- as.data.frame(x_sum)[, -1:-2]
  expected <- data.frame(
    Z = 2,
    `~HR at bound` = 1,
    `Nominal p` = 0,
    `Alternate hypothesis` = 1,
    `Null hypothesis` = 0,
    check.names = FALSE
  )
  expect_equal(observed, expected)

  # Drop variables and also specify the decimals
  x_sum <- summary(
    x,
    col_vars = c("nominal p", "Null hypothesis"),
    col_decimals = c(0, 0)
  )
  observed <- as.data.frame(x_sum)[, -1:-2]
  expected <- data.frame(`Nominal p` = 0, `Null hypothesis` = 0, check.names = FALSE)
  expect_equal(observed, expected)

  # Rearrange variables
  x_sum <- summary(
    x,
    col_vars = c("Null hypothesis", "Alternate hypothesis", "nominal p", "~hr at bound", "z"),
    col_decimals = c(0, 0, 0, 0, 0)
  )
  observed <- as.data.frame(x_sum)[, -1:-2]
  expected <- data.frame(
    `Null hypothesis` = 0,
    `Alternate hypothesis` = 1,
    `Nominal p` = 0,
    `~HR at bound` = 1,
    Z = 2,
    check.names = FALSE
  )
  expect_equal(observed, expected)

  # Throw error if unnamed col_decimals does not match length of col_vars
  expect_error(
    summary(
      x,
      col_vars = c("Null hypothesis", "Alternate hypothesis", "nominal p"),
      col_decimals = c(0, 0),
    ),
    "'col_vars' and 'col_decimals' must be of the same length"
  )
})

test_that("summary.gs_design() accepts a named vector for col_decimals", {
  x <- gs_design_ahr()

  # Specify decimals
  x_sum <- summary(x, col_decimals = c(z = 0, `nominal p` = 0))
  observed <- as.data.frame(x_sum)[, -1:-2]
  expected <- data.frame(
    Z = 2,
    `~HR at bound` = 0.795,
    `Nominal p` = 0,
    `Alternate hypothesis` = 0.9,
    `Null hypothesis` = 0.025,
    check.names = FALSE
  )
  expect_equal(observed, expected)

  # Specify decimals and also drop some variables
  x_sum <- summary(
    x,
    col_vars = c("z", "nominal p", "Null hypothesis"),
    col_decimals = c(z = 0, `nominal p` = 0)
  )
  observed <- as.data.frame(x_sum)[, -1:-2]
  expected <- data.frame(Z = 2, `Nominal p` = 0, `Null hypothesis` = 0.025, check.names = FALSE)
  expect_equal(observed, expected)

  # Specify decimals and rearrange some variables
  x_sum <- summary(
    x,
    col_vars = c("Null hypothesis", "nominal p", "z"),
    col_decimals = c(z = 0, `nominal p` = 0)
  )
  observed <- as.data.frame(x_sum)[, -1:-2]
  expected <- data.frame(`Null hypothesis` = 0.025, `Nominal p` = 0, Z = 2, check.names = FALSE)
  expect_equal(observed, expected)

  # Only drop variables
  x_sum <- summary(x, col_vars = c("z", "nominal p", "Null hypothesis"))
  observed <- as.data.frame(x_sum)[, -1:-2]
  expected <- data.frame(Z = 1.96, `Nominal p` = 0.025, `Null hypothesis` = 0.025, check.names = FALSE)
  expect_equal(observed, expected)

  # Throw error is col_decimals is unnamed
  expect_error(
    summary(x, col_decimals = c(4, 4)),
    "'col_decimals' must be a named vector if 'col_vars' is not provided"
  )
})