tests/testthat/test-cifpanel.R

In cifmodeling: Visualization and Polytomous Modeling of Survival and Competing Risks

test_that("cifpanel() accepts pre-built plots (grid mode)", {
  skip_on_cran()
  skip_if_not_installed("ggplot2")

  p1 <- ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) + ggplot2::geom_point()
  p2 <- ggplot2::ggplot(mtcars, ggplot2::aes(disp, qsec)) + ggplot2::geom_point()

  out <- cifpanel(
    plots = list(p1, p2),
    rows.columns.panel = c(1, 2),
    legend.collect = TRUE,
    legend.position = "bottom",
    print.panel = FALSE
  )

  expect_true(is.list(out))
  expect_true(all(c("list.plot", "patchwork") %in% names(out)))
  expect_equal(length(out$list.plot), 2L)
})

test_that("cifpanel() accepts pre-built plots (inset mode)", {
  skip_on_cran()
  skip_if_not_installed("ggplot2")

  p1 <- ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) + ggplot2::geom_point()
  p2 <- ggplot2::ggplot(mtcars, ggplot2::aes(disp, qsec)) + ggplot2::geom_point()

  out <- cifpanel(
    plots = list(p1, p2),
    inset.panel = TRUE,
    title.plot = c("Base", "Inset"),
    print.panel = FALSE
  )

  expect_true(is.list(out))
  expect_true(all(c("list.plot", "patchwork") %in% names(out)))
})


make_min_data <- function() {
  data.frame(
    time = c(1, 2, 3),
    status = c(0, 1, 2),
    A = c(0, 1, 0)
  )
}

make_min_inputs <- function() {
  list(
    K = 1L,
    formulas = list(Event(time, status) ~ A),
    data = make_min_data(),
    code.events = list(c(1, 2, 0)),
    outcome.flags = c("C"),
    outcome.list = list("competing-risk"),
    typey.list = list("risk"),
    labely.list = list("CIF"),
    labelx.list = list("Time"),
    limsx.list = NULL,
    limsy.list = NULL,
    breakx.list = NULL,
    breaky.list = NULL,
    addCI.list = list(TRUE),
    addCen.list = list(TRUE),
    addCR.list = list(FALSE),
    addIC.list = list(FALSE),
    addQ.list = list(FALSE),
    strata.list = NULL,
    legend.position = "top",
    dots = list(style = "classic", font.family = NULL, font.size = NULL)
  )
}

make_inputs_2panel <- function(df) {
  K <- 2L
  list(
    K = K,
    formulas = rep(list(Event(t, epsilon) ~ fruitq), K),
    data = df,
    code.events = list(c(1, 2, 0), c(2, 1, 0)),
    outcome.flags = c("C", "C"),
    outcome.list = list("competing-risk", "competing-risk"),
    typey.list = list("risk", "risk"),
    labely.list = list("Diabetic retinopathy", "Macrovascular complications"),
    labelx.list = list("Years from registration", "Years from registration"),
    limsx.list = NULL,
    limsy.list = NULL,
    breakx.list = NULL,
    breaky.list = NULL,
    addCI.list = list(TRUE, TRUE),
    addCen.list = list(TRUE, TRUE),
    addCR.list = list(FALSE, FALSE),
    addIC.list = list(FALSE, FALSE),
    addQ.list = list(FALSE, FALSE),
    strata.list = NULL,
    legend.position = "top",
    dots = list(style = "classic", font.family = NULL, font.size = NULL)
  )
}

test_that("cifpanel() produces expected outputs with competing risks data (no plotting)", {
  skip_on_cran()
  skip_if_not_installed("survival")
  skip_if_not_installed("ggsurvfit")

  data(diabetes.complications)

  out <- cifpanel(
    title.panel      = "A comparison of cumulative incidence of competing events",
    rows.columns.panel = c(1, 2),
    formula          = Event(t, epsilon) ~ fruitq,
    data             = diabetes.complications,
    outcome.type     = "competing-risk",
    code.events      = list(c(1, 2, 0), c(2, 1, 0)),
    label.y          = c("Diabetic retinopathy", "Macrovascular complications"),
    label.x          = "Years from registration",
    subtitle.panel   = "Stratified by fruit intake",
    caption.panel    = "Data: diabetes.complications",
    title.plot       = c("Diabetic retinopathy", "Macrovascular complications"),
    legend.position  = "bottom",
    legend.collect   = TRUE,
    print.panel      = FALSE
  )
  expect_true(is.list(out))
  expect_true(all(c("list.plot", "patchwork") %in% names(out)))
})

test_that("panel_prepare() returns curves and plot arguments", {
  skip_on_cran()
  skip_if_not_installed("survival")
  inputs <- make_min_inputs()
  prep <- do.call(cifmodeling:::panel_prepare, inputs)

  expect_true(is.list(prep$curves))
  expect_equal(length(prep$curves), inputs$K)
  expect_true(all(vapply(prep$curves, inherits, logical(1), what = "survfit")))

  expect_true(is.list(prep$plot_args))
  expect_equal(length(prep$plot_args), inputs$K)
  expect_true(all(vapply(prep$plot_args, is.list, logical(1))))
  expect_true(all(vapply(prep$plot_args, function(x) identical(x$legend.position, inputs$legend.position), logical(1))))

  expect_identical(prep$K, inputs$K)
})

test_that("panel_prepare() forwards subset and weights to cifcurve", {
  df <- data.frame(
    time = 1:8,
    status = c(0, 1, 2, 1, 0, 2, 1, 0),
    group = factor(rep(c("A", "B"), 4)),
    keep = c(TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE),
    w = c(1, 1, 5, 1, 1, 4, 1, 1)
  )

  prep <- cifmodeling:::panel_prepare(
    K = 1L,
    formulas = list(Event(time, status) ~ group),
    data = df,
    weights = "w",
    subset.condition = ~ keep,
    code.events = list(c(1, 2, 0)),
    outcome.flags = "C",
    outcome.list = list("competing-risk")
  )
  direct <- cifcurve(
    Event(time, status) ~ group,
    data = df,
    weights = "w",
    subset.condition = ~ keep,
    outcome.type = "competing-risk"
  )
  unweighted <- cifcurve(
    Event(time, status) ~ group,
    data = df,
    subset.condition = ~ keep,
    outcome.type = "competing-risk"
  )
  public_panel <- cifpanel(
    formula = Event(time, status) ~ group,
    data = df,
    weights = "w",
    subset.condition = ~ keep,
    outcome.type = "competing-risk",
    code.events = list(c(1, 2, 0)),
    print.panel = FALSE
  )

  testthat::expect_equal(prep$curves[[1L]]$time, direct$time)
  testthat::expect_equal(prep$curves[[1L]]$surv, direct$surv)
  testthat::expect_equal(public_panel$survfit.info$curves[[1L]]$surv, direct$surv)
  testthat::expect_lte(max(prep$curves[[1L]]$time), 6)
  testthat::expect_false(isTRUE(all.equal(direct$surv, unweighted$surv)))
})

test_that("panel_prepare() returns per-panel objects with expected structure", {
  skip_on_cran()
  skip_if_not_installed("survival")
  skip_if_not_installed("ggsurvfit")

  data(diabetes.complications)

  inputs <- make_inputs_2panel(diabetes.complications)
  prep <- do.call(cifmodeling:::panel_prepare, inputs)

  expect_true(is.list(prep))
  expect_identical(prep$K, inputs$K)

  expect_true(is.list(prep$curves))
  expect_equal(length(prep$curves), inputs$K)
  expect_true(all(vapply(prep$curves, inherits, logical(1), what = "survfit")))

  expect_true(is.list(prep$plot_args))
  expect_equal(length(prep$plot_args), inputs$K)
  expect_true(all(vapply(prep$plot_args, is.list, logical(1))))

  expect_true(all(vapply(prep$plot_args, function(x) identical(x$legend.position, inputs$legend.position), logical(1))))
  expect_true(identical(prep$plot_args[[1]]$label.x, inputs$labelx.list[[1]]))
  expect_true(identical(prep$plot_args[[1]]$label.y, inputs$labely.list[[1]]))
  expect_true(identical(prep$plot_args[[2]]$label.x, inputs$labelx.list[[2]]))
  expect_true(identical(prep$plot_args[[2]]$label.y, inputs$labely.list[[2]]))
})

test_that("cifpanel() with two formulas shows per-plot titles", {
  skip_if_not_installed("ggplot2")
  skip_if_not_installed("patchwork")

  df <- data.frame(
    t       = c(5, 7, 9, 10, 3, 4, 6, 8),
    epsilon = c(1, 0, 2, 0, 1, 2, 0, 1),
    x1      = factor(c("A","B","A","B","A","B","A","B")),
    x2      = c(0,1,0,1,1,0,1,0)
  )

  res <- cifpanel(
    formulas     = list(Event(t, epsilon) ~ x1,
                        Event(t, epsilon) ~ x2),
    data         = df,
    outcome.type = "competing-risk",
    code.events  = list(c(1, 2, 0), c(1, 2, 0)),
    title.plot   = c("Plot-x1", "Plot-x2"),
    print.panel  = FALSE
  )

  expect_type(res, "list")
  expect_length(res$list.plot, 2)
  expect_equal(res$list.plot[[1]]$labels$title, "Plot-x1")
  expect_equal(res$list.plot[[2]]$labels$title, "Plot-x2")
})

test_that("panel flags work", {
  skip()
  skip_if_not_installed("survival")
  skip_if_not_installed("ggsurvfit")
  skip_if_not_installed("patchwork")

  data(diabetes.complications)

  f1 <- Event(t, epsilon) ~ fruitq
  f2 <- Event(t, epsilon) ~ sex

  res <- cifpanel(
    formulas           = list(f1, f2),
    data               = diabetes.complications,
    outcome.type       = "competing-risk",
    panel.per.event    = TRUE,
    panel.censoring    = FALSE,
    panel.per.variable = TRUE,
    print.panel        = FALSE
  )

  expect_true(is.list(res))
  expect_true(
    inherits(res$patchwork, "patchwork") || inherits(res$patchwork, "gg")
  )
})

test_that("cifpanel() applies panel-level tag_levels", {
  skip_if_not_installed("ggplot2")
  skip_if_not_installed("patchwork")

  df <- data.frame(
    t       = c(5, 7, 9, 10),
    epsilon = c(1, 0, 2, 0),
    x       = c(0, 1, 0, 1)
  )

  res <- cifpanel(
    formulas     = list(Event(t, epsilon) ~ x,
                        Event(t, epsilon) ~ 1),
    data         = df,
    outcome.type = "competing-risk",
    code.events  = list(c(1, 2, 0), c(1, 2, 0)),
    tag.panel = "A",
    print.panel  = FALSE
  )

  ann <- res$patchwork$patches$annotation
  expect_false(is.null(ann))
  expect_equal(ann$tag_levels, "A")
})

test_that("cifplot(panel.per.event=TRUE) creates 2-event panel", {
  skip_if_not_installed("ggplot2")
  skip_if_not_installed("patchwork")

  df <- data.frame(
    t       = c(2, 4, 6, 8, 10, 12),
    epsilon = c(1, 0, 2, 0, 1, 2),
    trt     = c(0, 1, 0, 1, 0, 1)
  )

  p <- cifplot(
    Event(t, epsilon) ~ trt,
    data             = df,
    outcome.type     = "competing-risk",
    code.events      = c(1, 2, 0),
    panel.per.event   = TRUE,
    add.risktable     = FALSE,
    label.y          = c("Cumulative incidence of interest", "Cumulative incidence of competing risk"),
    print.panel      = FALSE
  )

  expect_s3_class(p, "cifpanel")
  expect_true(inherits(p$patchwork, "patchwork"))
  expect_equal(length(p$list.plot), 2)

  expect_equal(p$list.plot[[1]]$labels$y, "Cumulative incidence of interest")
  expect_equal(p$list.plot[[2]]$labels$y, "Cumulative incidence of competing risk")
})

test_that("cifpanel() can take per-panel label.x/label.y", {
  skip_if_not_installed("ggplot2")
  skip_if_not_installed("patchwork")

  df <- data.frame(
    t       = c(1, 2, 3, 4, 5, 6),
    epsilon = c(1, 0, 2, 0, 1, 2),
    g       = c(0, 0, 1, 1, 0, 1)
  )

  res <- cifpanel(
    formulas     = list(Event(t, epsilon) ~ g,
                        Event(t, epsilon) ~ 1),
    data         = df,
    outcome.type = "competing-risk",
    code.events  = list(c(1, 2, 0), c(1, 2, 0)),
    label.y      = list("CIF by group", "Overall CIF"),
    label.x      = list("Time (days)", "Time (days)"),
    print.panel  = FALSE
  )

  expect_equal(res$list.plot[[1]]$labels$y, "CIF by group")
  expect_equal(res$list.plot[[2]]$labels$y, "Overall CIF")
})

test_that("panel_recycle_to() enforces 1-or-n length rule", {
  rec <- cifmodeling:::panel_recycle_to

  x1 <- list("A")
  out1 <- rec(x1, n = 3L)
  expect_equal(length(out1), 3L)
  expect_equal(out1, list("A", "A", "A"))

  x2 <- list("A", "B")
  out2 <- rec(x2, n = 2L)
  expect_identical(out2, x2)

  x_bad <- list("A", "B", "C")
  expect_error(
    rec(x_bad, n = 2L),
    regexp = "Length mismatch"
  )
})

test_that("cifpanel() recycles scalar panel-wise arguments to all panels", {
  skip_if_not_installed("ggplot2")
  skip_if_not_installed("patchwork")

  df <- data.frame(
    t       = c(5, 7, 9, 10),
    epsilon = c(1, 0, 2, 0),
    x       = c(0, 1, 0, 1)
  )

  res <- cifpanel(
    formulas     = list(Event(t, epsilon) ~ x,
                        Event(t, epsilon) ~ 1),
    data         = df,
    outcome.type = "competing-risk",
    code.events  = list(c(1, 2, 0), c(1, 2, 0)),
    label.y      = "Shared Y label",   # 長さ1 → リサイクル
    print.panel  = FALSE
  )

  expect_length(res$list.plot, 2L)
  expect_equal(res$list.plot[[1]]$labels$y, "Shared Y label")
  expect_equal(res$list.plot[[2]]$labels$y, "Shared Y label")
})

test_that("cifpanel() errors when panel-wise argument length is not 1 or K", {
  skip_if_not_installed("ggplot2")
  skip_if_not_installed("patchwork")

  df <- data.frame(
    t       = c(5, 7, 9, 10),
    epsilon = c(1, 0, 2, 0),
    x       = c(0, 1, 0, 1)
  )

  # formulas が 2 なので K = 2
  expect_error(
    cifpanel(
      formulas     = list(Event(t, epsilon) ~ x,
                          Event(t, epsilon) ~ 1),
      data         = df,
      outcome.type = "competing-risk",
      code.events  = list(c(1, 2, 0), c(1, 2, 0)),
      label.y      = c("Y1", "Y2", "Y3"),  # 長さ 3 → ダメ
      print.panel  = FALSE
    ),
    regexp = "Length mismatch|length .*1 or 2",
    ignore.case = TRUE
  )
})


test_that("cifpanel() recycles scalar panel-wise arguments to all panels", {
  skip_if_not_installed("ggplot2")
  skip_if_not_installed("patchwork")

  df <- data.frame(
    t       = c(5, 7, 9, 10),
    epsilon = c(1, 0, 2, 0),
    x       = c(0, 1, 0, 1)
  )

  # formulas が 2 個 → K = 2
  res <- cifpanel(
    formulas     = list(Event(t, epsilon) ~ x,
                        Event(t, epsilon) ~ 1),
    data         = df,
    outcome.type = "competing-risk",
    code.events  = list(c(1, 2, 0), c(1, 2, 0)),
    label.y      = "Shared Y label",   # 長さ1（リサイクル期待）
    label.x      = "Time",             # 長さ1（リサイクル期待）
    print.panel  = FALSE
  )

  expect_equal(length(res$list.plot), 2L)
  expect_equal(res$list.plot[[1]]$labels$y, "Shared Y label")
  expect_equal(res$list.plot[[2]]$labels$y, "Shared Y label")
  expect_equal(res$list.plot[[1]]$labels$x, "Time")
  expect_equal(res$list.plot[[2]]$labels$x, "Time")
})


test_that("cifpanel() errors when panel-wise argument length is not 1 or K", {
  skip_if_not_installed("ggplot2")
  skip_if_not_installed("patchwork")

  df <- data.frame(
    t       = c(5, 7, 9, 10),
    epsilon = c(1, 0, 2, 0),
    x       = c(0, 1, 0, 1)
  )

  expect_error(
    cifpanel(
      formulas          = list(Event(t, epsilon) ~ x,
                               Event(t, epsilon) ~ 1),
      data              = df,
      outcome.type      = "competing-risk",
      code.events       = list(c(1, 2, 0), c(1, 2, 0)),
      rows.columns.panel = c(1, 2),
      label.y           = c("Y1", "Y2", "Y3"),
      print.panel       = FALSE
    ),
    regexp = "Length mismatch"
  )
})

test_that("cifpanel() enforces 1-or-K rule for panel-wise listable arguments", {
  skip_if_not_installed("ggplot2")
  skip_if_not_installed("patchwork")

  # K = 2 パネルのベース設定
  df <- data.frame(
    t       = c(5, 7, 9, 10),
    epsilon = c(1, 0, 2, 0),
    g       = c(0, 1, 0, 1)
  )

  base_args <- list(
    formulas          = list(Event(t, epsilon) ~ g,
                             Event(t, epsilon) ~ 1),
    data              = df,
    outcome.type      = "competing-risk",
    code.events       = list(c(1, 2, 0), c(1, 2, 0)),
    rows.columns.panel = c(1, 2),
    print.panel       = FALSE
  )

  check_bad_length <- function(arg_name, bad_value) {
    args2 <- base_args
    args2[[arg_name]] <- bad_value

    expect_error(
      do.call(cifpanel, args2),
      regexp = "Length mismatch",
      info   = paste("Argument:", arg_name)
    )
  }

  ## ここから 1-or-K ルールを期待したい panel-wise 引数たち

  # 文字列系
  check_bad_length("outcome.type",   list("competing-risk", "survival", "competing-risk"))
  check_bad_length("type.y",         list("risk", "risk", "risk"))
  check_bad_length("label.x",        list("Time1", "Time2", "Time3"))
  check_bad_length("label.y",        list("Y1", "Y2", "Y3"))

  # 数値レンジ系
  check_bad_length("limits.x",       list(c(0, 5), c(0, 5), c(0, 5)))
  check_bad_length("limits.y",       list(c(0, 1), c(0, 1), c(0, 1)))
  check_bad_length("breaks.x",       list(c(0, 5, 10), c(0, 5, 10), c(0, 5, 10)))
  check_bad_length("breaks.y",       list(c(0, 0.5, 1), c(0, 0.5, 1), c(0, 0.5, 1)))

  # logical トグル系
  check_bad_length("add.conf",                 list(TRUE, FALSE, TRUE))
  check_bad_length("add.censor.mark",          list(TRUE, TRUE, FALSE))
  check_bad_length("add.competing.risk.mark",  list(FALSE, TRUE, FALSE))
  check_bad_length("add.intercurrent.event.mark", list(FALSE, FALSE, TRUE))
  check_bad_length("add.quantile",             list(FALSE, TRUE, TRUE))
})


test_that("normalize_strata_info() respects level/labels consistency", {
  lvl <- c("0", "1")
  lab <- c("A", "B")
  out <- cifmodeling:::normalize_strata_info(
    level.strata = lvl,
    label.strata = lab
  )
  expect_equal(out$level, lvl)
  expect_equal(unname(out$label_map), lab)
})


test_that("cifpanel() accepts panel-wise list arguments (happy path)", {
  skip_on_cran()
  skip_if_not_installed("ggplot2")
  skip_if_not_installed("patchwork")

  df <- data.frame(
    t       = c(2, 4, 6, 8, 10, 12),
    epsilon = c(1, 0, 2, 0, 1, 2),
    trt     = c(0, 1, 0, 1, 0, 1)
  )

  ## 2 パネル想定
  args <- list(
    formulas     = list(
      Event(t, epsilon) ~ trt,
      Event(t, epsilon) ~ 1
    ),
    data         = df,
    outcome.type = list("competing-risk", "competing-risk"),
    code.events  = list(c(1, 2, 0), c(1, 2, 0)),

    ## per-panel ラベル
    label.x      = list("Time (years)", "Time (years)"),
    label.y      = list("CIF by treatment", "Overall CIF"),

    ## per-panel limits / breaks（実際の値はそこまで重要でない）
    limits.y     = list(c(0, 1), c(0, 1)),
    breaks.y     = list(seq(0, 1, 0.25), seq(0, 0.5, 0.1)),

    ## per-panel トグル類
    add.conf                 = list(TRUE, FALSE),
    add.censor.mark          = list(TRUE, FALSE),
    add.competing.risk.mark  = list(FALSE, FALSE),
    add.intercurrent.event.mark = list(FALSE, FALSE),
    add.quantile             = list(FALSE, TRUE),

    ## レイアウト
    rows.columns.panel = c(1, 2),
    print.panel        = FALSE
  )

  res <- do.call(cifpanel, args)

  ## cifpanel オブジェクトとして正常に生成されるか
  expect_s3_class(res, "cifpanel")
  expect_true(inherits(res$patchwork, "patchwork"))
  expect_length(res$list.plot, 2L)

  ## per-panel の label.x / label.y がちゃんと効いているか
  expect_equal(res$list.plot[[1]]$labels$y, "CIF by treatment")
  expect_equal(res$list.plot[[2]]$labels$y, "Overall CIF")
  expect_equal(res$list.plot[[1]]$labels$x, "Time (years)")
  expect_equal(res$list.plot[[2]]$labels$x, "Time (years)")

  ## ここまで来ていれば、list で渡した各種フラグや limits/breaks が
  ## 少なくともエラーなく処理されていることは確認できる
})


testthat::test_that("cifpanel returns a patchwork object for multi-panel inputs", {
  testthat::skip_if_not_installed("ggplot2")
  testthat::skip_if_not_installed("patchwork")

  data(diabetes.complications, package = "cifmodeling")

  old <- getOption("warn")
  options(warn = 2)
  on.exit(options(warn = old), add = TRUE)

  res <- cifmodeling::cifpanel(
    formulas = list(
      cifmodeling::Event(t, epsilon) ~ fruitq,
      cifmodeling::Event(t, epsilon) ~ sex
    ),
    data = diabetes.complications,
    outcome.type = "competing-risk",
    code.events = list(c(1, 2, 0), c(1, 2, 0)),
    add.risktable = FALSE,
    add.conf = FALSE,
    add.censor.mark = FALSE
  )

  testthat::expect_true(is.list(res))
  testthat::expect_true(!is.null(res$patchwork))
  testthat::expect_s3_class(res$patchwork, "patchwork")
})

# ---- helpers ---------------------------------------------------------------

.extract_panel_range <- function(p, axis = c("x", "y")) {
  axis <- match.arg(axis)
  b <- ggplot2::ggplot_build(p)
  pp <- b$layout$panel_params[[1]]

  if (axis == "x") {
    if (!is.null(pp$x.range)) return(pp$x.range)
    if (!is.null(pp$x$range$range)) return(pp$x$range$range)
    if (!is.null(pp$x$range)) return(pp$x$range)
    if (!is.null(b$layout$panel_scales_x[[1]]$range$range)) return(b$layout$panel_scales_x[[1]]$range$range)
  } else {
    if (!is.null(pp$y.range)) return(pp$y.range)
    if (!is.null(pp$y$range$range)) return(pp$y$range$range)
    if (!is.null(pp$y$range)) return(pp$y$range)
    if (!is.null(b$layout$panel_scales_y[[1]]$range$range)) return(b$layout$panel_scales_y[[1]]$range$range)
  }

  stop("Could not extract panel range from ggplot_build().")
}

.extract_cifpanel_plots <- function(res) {
  pw <- NULL
  if (is.list(res) && !is.null(res$patchwork)) pw <- res$patchwork
  if (inherits(res, "patchwork")) pw <- res
  if (is.null(pw) || !inherits(pw, "patchwork")) stop("No patchwork found in cifpanel result.")

  plots <- pw$patches$plots
  plots <- Filter(Negate(is.null), plots)
  plots
}

.get_x_range <- function(p) {
  b <- ggplot2::ggplot_build(p)
  pp <- b$layout$panel_params[[1]]

  xr <- pp$x.range
  if (is.null(xr)) xr <- pp$x$range$range
  xr
}

.expect_xrange_includes_limits_with_padding <- function(xr, lim, pad_frac_max = 0.25, tol = 1e-8) {
  testthat::expect_true(is.numeric(xr) && length(xr) == 2L)

  span <- lim[2] - lim[1]

  # 重要：指定した limits 区間を「含む」こと
  testthat::expect_lte(xr[1], lim[1] + tol)
  testthat::expect_gte(xr[2], lim[2] - tol)

  # 余白は「小さい」こと（パッチで 2%〜程度を想定、上限は緩めに 25%）
  testthat::expect_gte(xr[1], lim[1] - pad_frac_max * span - tol)
  testthat::expect_lte(xr[2], lim[2] + pad_frac_max * span + tol)

  # 今回の仕様：lim[1]=0 のときは左が負にずれる（原点が 0 固定にならない）
  if (abs(lim[1]) < 1e-12) testthat::expect_lt(xr[1], 0 + tol)

  # 右マージンも入れる仕様なら、右端は lim[2] より大きいはず
  testthat::expect_gt(xr[2], lim[2] - tol)
}

# ---- axis regression tests -------------------------------------------------

testthat::test_that("cifpanel respects limits.x even when breaks.x is supplied (scale_x_continuous path)", {
  testthat::skip_if_not_installed("ggplot2")
  testthat::skip_if_not_installed("patchwork")

  data(diabetes.complications, package = "cifmodeling")

  old <- getOption("warn")
  options(warn = 2)
  on.exit(options(warn = old), add = TRUE)

  res <- cifmodeling::cifpanel(
    formulas = list(
      cifmodeling::Event(t, epsilon) ~ fruitq,
      cifmodeling::Event(t, epsilon) ~ sex
    ),
    data = diabetes.complications,
    outcome.type = "competing-risk",
    code.events = list(c(1, 2, 0), c(1, 2, 0)),
    rows.columns.panel = c(1, 2),
    axis.info = list(use.coord.cartesian = FALSE),

    limits.x = list(c(0, 120), c(0, 120)),
    breaks.x = list(seq(0, 120, 12), seq(0, 120, 12)),

    limits.y = list(c(0, 1), c(0, 1)),
    add.risktable = FALSE,
    add.conf = FALSE,
    add.censor.mark = FALSE
  )

  testthat::expect_true(is.list(res))
  testthat::expect_true(!is.null(res$list.plot))
  testthat::expect_gte(length(res$list.plot), 2L)

  lim <- c(0, 120)

  plots <- res$list.plot[1:2]
  for (p in plots) {
    testthat::expect_s3_class(p, "ggplot")
    xr <- .get_x_range(p)
    .expect_xrange_includes_limits_with_padding(xr, lim, pad_frac_max = 0.25)
  }
})


testthat::test_that("cifpanel errors if a panel-wise list argument length is neither 1 nor K", {

  data(diabetes.complications, package = "cifmodeling")
  old <- getOption("warn")
  options(warn = 2)
  on.exit(options(warn = old), add = TRUE)

  testthat::expect_error(
    cifmodeling::cifpanel(
      formulas = list(
        cifmodeling::Event(t, epsilon) ~ fruitq,
        cifmodeling::Event(t, epsilon) ~ sex
      ),
      data = diabetes.complications,
      outcome.type = "competing-risk",
      code.events = list(c(1, 2, 0), c(1, 2, 0)),
      rows.columns.panel = c(1, 2),

      # K=2 に対して長さ3（1でも2でもない）→ ここで落ちるのが期待
      limits.x = list(c(0, 120), c(0, 120), c(0, 120)),
      breaks.x = list(seq(0, 120, 12), seq(0, 120, 12)),
      limits.y = list(c(0, 1), c(0, 1)),

      add.risktable = FALSE,
      add.conf = FALSE,
      add.censor.mark = FALSE
    )
  )
})