R/cifplot.R

Defines functions check_ggsurvfit call_ggsurvfit_old call_ggsurvfit cifplot_single plot_panel.censoring plot_panel.per.event plot_panel.per.variable cifplot

Documented in cifplot

#' @title Generate a survival/CIF curve with marks that represent
#' censoring, competing risks and intercurrent events
#'
#' @description
#' This function generates a survival or CIF curve from a unified formula–data
#' interface or from an existing survfit object. When a formula is supplied,
#' the LHS is typically `Event()` or `survival::Surv()`, and the RHS specifies
#' an optional stratification variable. In addition to the curves themselves,
#' [cifplot()] can add numbers-at-risk tables, tables of point estimates and
#' CIs, censoring marks, competing-risk marks, and intercurrent-event marks.
#'
#' For usual single-panel mode, the function returns an object whose `plot`
#' component is a regular ggplot object that can be further modified.
#' Use `as_ggplot(result) + ggplot2::labs(...)` or `result$plot + ...`;
#' the wrapper itself is not a ggplot.
#' For more complex multi-panel displays, [cifplot()] can internally call
#' [cifpanel()] via several “panel modes” (per event, per variable, or
#' censoring-focused).
#'
#' @inheritParams cif-stat-arguments
#' @inheritParams cif-visual-arguments
#'
#' @param formula_or_fit Either a model formula or a survfit object. When a formula is
#'   supplied, the LHS must be `Event(time, status)` or `Surv(time, status)`.
#'   The RHS specifies an optional stratification variable.
#' @param code.events Optional specification of event/censoring codes.
#'   For single-panel calls, supply a numeric vector. For competing-risk outcomes, use `c(event1, event2, censoring)`.
#'   For survival outcomes, a length-2 or length-3 vector is allowed:
#'   `c(event, censoring)` or `c(event, *, censoring)`, where any middle element is ignored.
#'   When supplied, this argument overrides `code.event1`, `code.event2`, and `code.censoring` for the purpose of estimation.
#'   For panel displays (e.g. `cifpanel()` or when `panel.per.event = TRUE` or
#'   `panel.censoring = TRUE`), `code.events` may also be a list of such numeric vectors, one per panel.
#' @param panel.per.event Logical. **Explicit panel mode.** If `TRUE` and
#'   `outcome.type == "competing-risk"`, [cifplot()] internally calls [cifpanel()]
#'   to display two event-specific CIFs side-by-side (event 1 and event 2) using
#'   reversed `code.events`. Ignored for non-competing-risk outcomes.
#' @param panel.censoring Logical. **Explicit panel mode.** If `TRUE` and
#'   `outcome.type == "survival"`, [cifplot()] internally calls [cifpanel()]
#'   to display KM curves for `(event, censor)` and `(censor, event)` so that
#'   censoring patterns can be inspected.
#' @param panel.per.variable Logical. **Explicit panel mode.** If `TRUE` and the RHS
#'   of the formula has multiple covariates (e.g. `~ a + b + c`), the function produces
#'   a panel where each variable in the RHS is used once as the stratification factor.
#' @param panel.mode Character specifying **Automatic panel mode.** If `"auto"` and none of
#'   `panel.per.variable`, `panel.per.event`, `panel.censoring` has been set to `TRUE`,
#'   the function chooses a suitable panel mode automatically:
#'   (i) if the formula RHS has 2+ variables, it behaves like `panel.per.variable = TRUE`;
#'   (ii) otherwise, if `outcome.type == "competing-risk"`, it behaves like
#'   `panel.per.event = TRUE`; (iii) otherwise, if `outcome.type == "survival"`, it
#'   behaves like `panel.censoring = TRUE`. If a panel mode is explicitly specified,
#'   `panel.mode` is ignored.
#' @param survfit.info,axis.info,visual.info,panel.info,style.info,inset.info,print.info,ggsave.info
#'   Internal lists used for programmatic control. Not intended for direct user input.
#' @param ... Additional arguments passed to internal helper functions.
#'
#' @details
#'
#' ### Typical use cases
#' -   Draw one survival/CIF curve set by exposure groups (e.g., treatment vs control).
#' -   Call `cifpanel()` with a simplified code to create a panel displaying plots of multiple stratified survival/CIF curves or CIF curves for each event type.
#' -   Add CIs and censor/competing-risk/intercurrent-event marks.
#' -   Add number-at-risk table to display the number at risk or the estimated survival probabilities or CIFs and CIs at each point in time.
#'
#' ### Key arguments shared with cifcurve()
#' -   **Outcome type and estimator**
#'       -   `outcome.type = "survival"`: Kaplan-Meier estimator
#'       -   `outcome.type = "competing-risk"`: Aalen-Johansen estimator
#'
#' -   **Confidence intervals**
#'       -   `conf.int` sets the two-sided level (default 0.95)
#'       -   `conf.type` chooses the transformation (`"arcsine-square root"`, `"plain"`, `"log"`, `"log-log"`, `"logit"`, or `"none"`)
#'       -   `error` chooses the estimator for SE (`"greenwood"`, `"tsiatis"` or `"if"` for survival curves and `"delta"`, `"aalen"` or `"if"` for CIFs)
#' -   **Risk sets used in tables**
#'       -   `n.risk.type` controls whether `$n.risk` reflects weighted, unweighted, or effective sample size counts when building risk tables (forwarded to [cifcurve()]); when a fitted `survfit` object is supplied, existing risk sets are used as-is.
#'
#' ### Key arguments for cifplot()
#' -   **Data visualization**
#'       -   `add.conf` adds CIs on the ggplot2-based plot
#'       -   `add.competing.risk.mark` and `add.intercurrent.event.mark` adds symbols to describe competing risks or intercurrent events in addition to conventional censoring marks with `add.censor.mark`
#'       -   `add.risktable` adds numbers at risk
#'       -   `add.estimate.table` adds time-by-time estimates and CIs
#'       -   `add.quantile` adds a reference line at a chosen quantile level
#'
#' -   **Plot customization**
#'       -   `type.y` chooses y-axis (`"surv"` for survival and `"risk"` for 1-survival/CIF)
#'       -   `limits.x`, `limits.y`, `breaks.x`, `breaks.y`: numeric vectors for axis control
#'       -   `style` specifies the appearance of plot (`"classic"`, `"bold"`, `"framed"`, `"grid"`, `"gray"` or `"ggsurvfit"`)
#'       -   `palette` specifies color of each curve (e.g. `palette=c("blue1", "cyan3", "navy", "deepskyblue3"))`)
#'
#' -   **Panel display**
#'       -   `panel.per.variable` produces multiple survival/CIF curves per stratification variable specified in the formula
#'       -   `panel.per.event` produces CIF curves for each event type
#'       -   `panel.censoring` produces the Kaplan–Meier curves for (event, censor) and (censor, event) so that censoring patterns can be inspected
#'       -   `panel.mode` uses automatic panel mode
#'
#' When \code{panel.per.event = TRUE}, two panels are created with
#' \code{code.events = list(c(e1, e2, c), c(e2, e1, c))}, where
#' \code{code.events = c(e1, e2, c)} is the input coding for event1, event2, and censoring.
#' Common legend is collected by default (\code{legend.collect = TRUE}).
#'
#' Numeric stratification variables are normalized automatically. Columns with
#' fewer than nine distinct numeric values are coerced to factors; columns with
#' nine or more distinct numeric values are split at the median into
#' \dQuote{Below median} and \dQuote{Above median} strata.
#'
#' ### Advanced control not required for typical use
#'
#' The arguments below fine-tune internal estimation and figure appearance.
#' **Most users do not need to change these defaults.**
#'
#' #### Graphical layers
#'
#' | Argument | Description | Default |
#' |---|---|---|
#' | `add.conf` | Add confidence interval ribbon. | `TRUE` |
#' | `add.risktable` | Add numbers-at-risk table below the plot. | `TRUE` |
#' | `add.estimate.table` | Add estimates and confidence intervals table. | `FALSE` |
#' | `symbol.risk.table` |  Symbol for strata in risk / estimate tables | `"square"` |
#' | `font.size.risk.table` |  Font size for texts in risk / estimate tables | `3` |
#' | `add.censor.mark` | Add censoring marks. | `TRUE` |
#' | `add.competing.risk.mark` | Add marks for event2 of "competing-risk" outcome. | `FALSE` |
#' | `add.intercurrent.event.mark` | Add intercurrent event marks at user-specified times. | `FALSE` |
#' | `add.quantile` | Add quantile reference lines. | `FALSE` |
#' | `level.quantile` | Quantile level for `add.quantile`. | `0.5` |
#'
#' #### Time for marks
#'
#' | Argument | Description|
#' |---|---|
#' | `competing.risk.time` | **Named list** of numeric vectors that contains times of competing risks. Names must match strata labels. Typically created internally|
#' | `intercurrent.event.time` | **Named list** of numeric vectors that contains times of intercurrent events. Names must match strata labels. Typically created by `extract_time_to_event()`. |
#'
#' #### Appearance of marks
#'
#' | Argument | Applies to | Default |
#' |---|---|---|
#' | `shape.censor.mark` | Censoring marks | `3` (cross) |
#' | `size.censor.mark` | Censoring marks | `2` |
#' | `shape.competing.risk.mark` | Competing-risk marks | `16` (filled circle) |
#' | `size.competing.risk.mark` | Competing-risk marks | `2` |
#' | `shape.intercurrent.event.mark` | Intercurrent marks | `1` (circle) |
#' | `size.intercurrent.event.mark` | Intercurrent marks | `2` |
#'
#' #### Panel display
#'
#' | Argument | Description |
#' |---|---|
#' | `panel.per.variable` | One panel per stratification variable |
#' | `panel.per.event` | For `"competing-risk"`, show CIFs of event 1 and event 2 |
#' | `panel.censoring` | For survival, show (event, censor) vs (censor, event) |
#' | `panel.mode` with 2+ stratification variables | Behave like `panel.per.variable` |
#' | `panel.mode` with outcome.type = "competing-risk" | Behave like `panel.per.event` |
#' | `panel.mode` with outcome.type = "survival" | Behave like `panel.censoring` |
#'
#' #### Axes and legend
#'
#' | Argument | Description | Default |
#' |---|---|---|
#' | `limits.x`, `limits.y` | Axis limits (`c(min, max)`) | Auto |
#' | `breaks.x`, `breaks.y` | Tick breaks for x and y axes | Auto |
#' | `use.coord.cartesian` | For zooming use `coord_cartesian()` | `FALSE` |
#' | `legend.position` |`"top"`, `"right"`, `"bottom"`, `"left"`, `"none"` | `"top"` |
#'
#' #### Export
#'
#' | Argument | Description | Default |
#' |---|---|---|
#' | `filename.ggsave` | If non-`NULL`, save the plot using `ggsave()` | `NULL` |
#' | `width.ggsave` | Size passed to `ggsave()` | `6`|
#' | `height.ggsave` | Size passed to `ggsave()` | `6`|
#' | `dpi.ggsave` | DPI passed to `ggsave()` | `300` |
#'
#' **Notes**
#' - For CIF displays, set `type.y = "risk"`. For survival scale, use `type.y = NULL` or `= "surv"`.
#' For a cumulative hazard plot, use `type.y = "cumhaz"`. To generate a log-log plot, use `type.y = "cloglog"`.
#' - Event coding can be controlled via `code.event1`, `code.event2`, `code.censoring`.
#'   For ADaM-style data, use `code.event1 = 0`, `code.censoring = 1`.
#' - Per-stratum time lists should have names identical to plotted strata labels.
#'
#' @return
#' A `"cifplot"` object (a list) with at least the following elements:
#'
#' - `plot`: a ggplot object containing the main plot
#' - `patchwork`: reserved for compatibility with panel displays
#'   (typically `NULL` for single-panel plots)
#' - `survfit.info`, `axis.info`, `visual.info`, `panel.info`,
#'   `style.info`, `inset.info`, `print.info`, `ggsave.info`:
#'   internal lists storing the fitted curves and display settings
#' - `version`: a character string giving the cifmodeling version used
#' - `call`: the original function call
#'
#' When a panel mode is active and `print.panel = TRUE`, the panel is also printed in interactive sessions.
#'
#' @examples
#' data(diabetes.complications)
#' cifplot(Event(t,epsilon) ~ fruitq,
#'         data = diabetes.complications,
#'         outcome.type="competing-risk",
#'         add.risktable = FALSE,
#'         label.y='CIF of diabetic retinopathy',
#'         label.x='Years from registration')
#'
#' @importFrom ggsurvfit ggsurvfit add_confidence_interval add_risktable add_risktable_strata_symbol add_censor_mark add_quantile
#' @importFrom ggplot2 theme_classic theme_bw element_text element_rect element_blank labs lims geom_point aes
#' @importFrom ggplot2 ggsave guides scale_color_discrete scale_fill_discrete scale_color_manual
#' @importFrom ggplot2 scale_fill_manual scale_linetype_manual scale_linetype_discrete scale_shape_discrete scale_shape_manual
#' @importFrom grDevices gray
#' @importFrom patchwork wrap_plots
#'
#' @name cifplot
#' @section Lifecycle:
#' \lifecycle{stable}
#' @seealso [polyreg()] for log-odds product modeling of CIFs; [cifcurve()] for KM/AJ estimators; [cifpanel()] for display of multiple CIFs; [ggsurvfit][ggsurvfit], [patchwork][patchwork] and [modelsummary][modelsummary] for display helpers.
#' @export
cifplot <- function(
    formula_or_fit,
    data                          = NULL,
    weights                       = NULL,
    subset.condition              = NULL,
    na.action                     = na.omit,
    outcome.type                  = "competing-risk",
    code.event1                   = 1,
    code.event2                   = 2,
    code.censoring                = 0,
    code.events                   = NULL,
    error                         = NULL,
    conf.type                     = "arcsine-square root",
    conf.int                      = 0.95,
    n.risk.type                   = c("weighted", "unweighted", "ess"),
    type.y                        = NULL,
    label.x                       = "Time",
    label.y                       = NULL,
    label.strata                  = NULL,
    level.strata                  = NULL,
    order.strata                  = NULL,
    limits.x                      = NULL,
    limits.y                      = NULL,
    breaks.x                      = NULL,
    breaks.y                      = NULL,
    use.coord.cartesian           = FALSE,
    add.conf                      = TRUE,
    add.risktable                 = TRUE,
    add.estimate.table            = FALSE,
    symbol.risk.table             = "square",
    font.size.risk.table          = 3,
    add.censor.mark               = TRUE,
    shape.censor.mark             = 3,
    size.censor.mark              = 2,
    add.competing.risk.mark       = FALSE,
    competing.risk.time           = list(),
    shape.competing.risk.mark     = 16,
    size.competing.risk.mark      = 2,
    add.intercurrent.event.mark   = FALSE,
    intercurrent.event.time       = list(),
    shape.intercurrent.event.mark = 1,
    size.intercurrent.event.mark  = 2,
    add.quantile                  = FALSE,
    level.quantile                = 0.5,
    panel.per.event               = FALSE,
    panel.censoring               = FALSE,
    panel.per.variable            = FALSE,
    panel.mode                    = "auto",
    rows.columns.panel            = NULL,
    style                         = "classic",
    palette                       = NULL,
    linewidth                     = 0.8,
    linetype                      = FALSE,
    font.family                   = "sans",
    font.size                     = 12,
    legend.position               = "top",
    print.panel                   = FALSE,
    filename.ggsave               = NULL,
    width.ggsave                  = 6,
    height.ggsave                 = 6,
    dpi.ggsave                    = 300,
    survfit.info                  = NULL,
    axis.info                     = NULL,
    visual.info                   = NULL,
    panel.info                    = NULL,
    style.info                    = NULL,
    inset.info                    = NULL,
    print.info                    = NULL,
    ggsave.info                   = NULL,
    ...
) {
  weights.expr <- substitute(weights)
  weights.missing <- missing(weights)
  dots <- list(...)
  dots$print.panel <- dots$print.panel %||% print.panel
  weights <- util_resolve_weights(
    weights.expr = weights.expr,
    data = data,
    envir = parent.frame(),
    missing = weights.missing
  )

  n.risk.type.missing <- missing(n.risk.type)
  n.risk.type <- util_check_n_risk_type(n.risk.type)

  infos <- cifplot_build_info(
    error                         = error,
    conf.type                     = conf.type,
    conf.int                      = conf.int,
    n.risk.type                   = n.risk.type,

    type.y                        = type.y,
    label.x                       = label.x,
    label.y                       = label.y,
    level.strata                  = level.strata,
    label.strata                  = label.strata,
    order.strata                  = order.strata,
    limits.x                      = limits.x,
    limits.y                      = limits.y,
    breaks.x                      = breaks.x,
    breaks.y                      = breaks.y,
    use.coord.cartesian           = use.coord.cartesian,

    add.conf         = add.conf,
    add.risktable                  = add.risktable,
    symbol.risk.table              = symbol.risk.table,
    add.estimate.table              = add.estimate.table,
    font.size.risk.table           = font.size.risk.table,
    add.censor.mark                 = add.censor.mark,
    shape.censor.mark             = shape.censor.mark,
    size.censor.mark              = size.censor.mark,
    add.competing.risk.mark          = add.competing.risk.mark,
    competing.risk.time           = competing.risk.time,
    shape.competing.risk.mark     = shape.competing.risk.mark,
    size.competing.risk.mark      = size.competing.risk.mark,
    add.intercurrent.event.mark      = add.intercurrent.event.mark,
    intercurrent.event.time       = intercurrent.event.time,
    shape.intercurrent.event.mark = shape.intercurrent.event.mark,
    size.intercurrent.event.mark  = size.intercurrent.event.mark,
    add.quantile               = add.quantile,
    level.quantile                      = level.quantile,

    panel.per.event                = panel.per.event,
    panel.censoring                = panel.censoring,
    panel.per.variable                  = panel.per.variable,
    rows.columns.panel            = rows.columns.panel,

    style           = style,
    palette         = palette,
    linewidth       = linewidth,
    linetype        = linetype,
    font.family     = font.family,
    font.size       = font.size,
    legend.position = legend.position,

    filename.ggsave = filename.ggsave,
    width.ggsave    = width.ggsave,
    height.ggsave   = height.ggsave,
    dpi.ggsave      = dpi.ggsave,

    survfit.info    = survfit.info,
    axis.info       = axis.info,
    visual.info     = visual.info,
    panel.info      = panel.info,
    style.info      = style.info,
    ggsave.info     = ggsave.info
  )

  survfit.info <- infos$survfit.info
  axis.info    <- infos$axis.info
  visual.info  <- infos$visual.info
  panel.info   <- infos$panel.info
  style.info   <- infos$style.info
  ggsave.info  <- infos$ggsave.info
  inset.info   <- inset.info %||% list()
  print.info   <- print.info %||% list()
  survfit.info$n.risk.type <- survfit.info$n.risk.type %||% n.risk.type

  style.info$font.family <- style.info$font.family %||% "sans"
  style.info$font.size   <- style.info$font.size   %||% 12

  level_input <- axis.info$level.strata
  order_input <- axis.info$order.strata

  norm <- normalize_strata_info(
    level.strata = axis.info$level.strata,
    label.strata = axis.info$label.strata,
    order.strata = axis.info$order.strata
  )
  axis.info$level.strata <- norm$level
  axis.info$order.strata <- norm$order_data
  axis.info$label.strata <- norm$label_map

  if (!is.null(axis.info$label.strata)) {
    stopifnot(!is.null(names(axis.info$label.strata)))
  }
  if (!is.null(order_input) && !is.null(level_input)) {
    if (!all(as.character(order_input) %in% as.character(level_input))) {
      warning("order.strata has unknown levels; ignoring order/label application.")
      axis.info$order.strata <- NULL
      axis.info$label.strata <- NULL
    }
  }

  .assert(
    sum(isTRUE(panel.info$panel.per.variable),
        isTRUE(panel.info$panel.per.event),
        isTRUE(panel.info$panel.censoring)) <= 1,
    "incompatible_flags",
    which = "panel.per.variable, panel.per.event, panel.censoring"
  )

  if (!inherits(formula_or_fit, "survfit")) {
    outcome.type <- util_check_outcome_type_for_analysis(
      x = outcome.type,
      formula = formula_or_fit,
      data = data,
      subset.condition = subset.condition,
      na.action = na.action,
      weights = weights
    )
  } else if (!n.risk.type.missing) {
    warning("`n.risk.type` is ignored when a fitted survfit object is supplied.", call. = FALSE)
  }

  if (!is.null(code.events)) {
    ce <- code.events
    if (is.list(ce)) {
      .assert(length(ce) >= 1L, "code_events_len_vec")
      ce <- ce[[1L]]
    }

    ce <- drop(as.vector(ce))

    .assert(length(ce) >= 2L, "code_events_len_vec")
    .assert(is.numeric(ce) || is.integer(ce), "code_events_integer")
    ce <- as.integer(ce)
    .assert(all(is.finite(ce)), "code_events_integer")

    if (!is.null(outcome.type) && identical(outcome.type, "survival")) {
      code.event1    <- ce[1L]
      code.censoring <- ce[length(ce)]
    } else {
      .assert(length(ce) >= 3L, "code_events_len_vec")
      code.event1    <- ce[1L]
      code.event2    <- ce[2L]
      code.censoring <- ce[3L]
      .assert(code.event1 != code.event2, "code_events_distinct")
    }
  }


  if (isTRUE(add.competing.risk.mark) && length(competing.risk.time) == 0) {
    visual.info$competing.risk.time <- extract_time_to_event(
      formula_or_fit, data=data, subset.condition=subset.condition, na.action=na.action, which.event="event2",
      code.event1=code.event1, code.event2=code.event2, code.censoring=code.censoring)
  }

  panel_mode <- plot_decide_panel_mode(
    formula_or_fit = formula_or_fit,
    data           = data,
    outcome.type   = outcome.type,
    panel.info     = panel.info,
    panel.mode     = panel.mode
  )
  panel.info$panel.per.variable <- identical(panel_mode, "each_var")
  panel.info$panel.per.event    <- identical(panel_mode, "each_event")
  panel.info$panel.censoring    <- identical(panel_mode, "censoring")
  is_panel <- isTRUE(panel.info$panel.per.variable) ||
    isTRUE(panel.info$panel.per.event) ||
    isTRUE(panel.info$panel.censoring)
  if (is_panel) {
    style.info$font.size <- style.info$font.size / 2
    style.info$legend.position <- "none"
    if (!is.null(axis.info$label.strata)) .warn("panel_disables_labelstrata")
    if (isTRUE(visual.info$add.risktable) || isTRUE(visual.info$add.estimate.table)) .warn("panel_disables_tables")
    axis.info$label.strata      <- NULL
    visual.info$add.risktable   <- FALSE
    visual.info$add.estimate.table <- FALSE
  }

  panel.info$panel.per.variable <- identical(panel_mode, "each_var")
  panel.info$panel.per.event    <- identical(panel_mode, "each_event")
  panel.info$panel.censoring    <- identical(panel_mode, "censoring")

  if (isTRUE(panel.info$panel.per.variable)) {
    style.info$legend.position <- "none"
    .assert(!inherits(formula_or_fit, "survfit"), "need_formula_for_panel.per.variable")
    .assert(inherits(formula_or_fit, "formula"),  "formula_must_be")
    .assert(!is.null(data),                       "need_data")

    out_pv <- do.call(
      plot_panel.per.variable,
      c(list(
        formula          = formula_or_fit,
        data             = data,
        weights          = weights,
        subset.condition = subset.condition,
        na.action        = na.action,
        outcome.type     = outcome.type,
        code.event1      = code.event1,
        code.event2      = code.event2,
        code.censoring   = code.censoring,
        n.risk.type      = n.risk.type,
        survfit.info     = survfit.info,
        axis.info        = axis.info,
        visual.info      = visual.info,
        panel.info       = panel.info,
        style.info       = style.info,
        ggsave.info      = ggsave.info
      ), dots)
    )
    if (!is.null(out_pv)) return(out_pv)
  }

  if (isTRUE(panel.info$panel.per.event)) {
    style.info$legend.position <- "none"
    if (inherits(formula_or_fit, "survfit")) {
      warning("panel.per.event=TRUE requires a formula interface; falling back to single-plot.")
    } else {
      out_pe <- plot_panel.per.event(
        formula            = formula_or_fit,
        data               = data,
        weights            = weights,
        axis.info          = axis.info,
        visual.info        = visual.info,
        panel.info         = panel.info,
        style.info         = style.info,
        ggsave.info        = ggsave.info,
        survfit.info       = survfit.info,
        dots               = dots,
        code.event1        = code.event1,
        code.event2        = code.event2,
        code.censoring     = code.censoring,
        outcome.type       = outcome.type,
        n.risk.type        = n.risk.type,
        rows.columns.panel = rows.columns.panel,
        subset.condition   = subset.condition,
        na.action          = na.action
      )
      if (!is.null(out_pe)) return(out_pe)
    }
  }

  if (isTRUE(panel.info$panel.censoring)) {
    style.info$legend.position <- "none"
    if (inherits(formula_or_fit, "survfit")) {
      warning("panel.censoring=TRUE requires a formula interface; falling back to single-plot.")
    } else {
      out_pe <- plot_panel.censoring(
        formula            = formula_or_fit,
        data               = data,
        weights            = weights,
        axis.info          = axis.info,
        visual.info        = visual.info,
        panel.info         = panel.info,
        style.info         = style.info,
        ggsave.info        = ggsave.info,
        survfit.info       = survfit.info,
        dots               = dots,
        code.event1        = code.event1,
        code.event2        = code.event2,
        code.censoring     = code.censoring,
        outcome.type       = outcome.type,
        n.risk.type        = n.risk.type,
        rows.columns.panel = rows.columns.panel,
        subset.condition   = subset.condition,
        na.action          = na.action
      )
      if (!is.null(out_pe)) return(out_pe)
    }
  }

  dots_clean <- plot_make_dots_clean(dots)
  args_single <- c(
    list(
      formula_or_fit   = formula_or_fit,
      data             = data,
      weights          = weights,
      subset.condition = subset.condition,
      na.action        = na.action,
      outcome.type     = outcome.type,
      code.event1      = code.event1,
      code.event2      = code.event2,
      code.censoring   = code.censoring,
      code.events      = NULL,
      n.risk.type      = n.risk.type,
      survfit.info     = survfit.info,
      axis.info        = axis.info,
      visual.info      = visual.info,
      panel.info       = panel.info,
      style.info       = style.info,
      ggsave.info      = ggsave.info
    ),
    dots_clean
  )


  out_plot <- do.call(cifplot_single, args_single)
  fit_single <- attr(out_plot, "cifmodeling_survfit")
  attr(out_plot, "cifmodeling_survfit") <- NULL
  out_plot <- apply_strata_to_plots(
    list(out_plot),
    order_data = axis.info$order.strata,
    label_map  = axis.info$label.strata
  )[[1]]

  survfit.info$formula_or_fit <- survfit.info$formula_or_fit %||% formula_or_fit
  survfit.info$outcome.type   <- survfit.info$outcome.type   %||% outcome.type
  survfit.info$code.event1    <- survfit.info$code.event1    %||% code.event1
  survfit.info$code.event2    <- survfit.info$code.event2    %||% code.event2
  survfit.info$code.censoring <- survfit.info$code.censoring %||% code.censoring
  survfit.info$code.events    <- survfit.info$code.events    %||% code.events
  survfit.info$data.name      <- survfit.info$data.name      %||% deparse(substitute(data))

  survfit_obj <- NULL
  if (inherits(formula_or_fit, "survfit")) {
    survfit_obj <- formula_or_fit
  } else if (inherits(fit_single, "survfit")) {
    survfit_obj <- fit_single
  }
  survfit.info$survfit <- survfit.info$survfit %||% survfit_obj
  survfit.info$n.risk.type <- survfit.info$n.risk.type %||%
  (if (inherits(survfit_obj, "survfit")) survfit_obj$n.risk.type else n.risk.type)

  print.info <- print.info %||% list()
  print.info$print.panel <- isTRUE(print.panel)
  print.info$engine      <- print.info$engine %||% "cifplot_single"

  ret <- list(
    plot         = out_plot,
    patchwork    = NULL,
    survfit.info = survfit.info,
    axis.info    = axis.info,
    visual.info  = visual.info,
    panel.info   = panel.info,
    style.info   = style.info,
    inset.info   = inset.info %||% list(),
    print.info   = print.info,
    ggsave.info  = ggsave.info,
    version      = utils::packageVersion("cifmodeling"),
    call         = match.call()
  )
  class(ret) <- c("cifplot", class(ret))

  if (interactive() && isTRUE(ret$print.info$print.panel)) {
    print(ret$plot)
    invisible(ret)
  } else {
    ret
  }
}

plot_panel.per.variable <- function(
    formula,
    data,
    weights = NULL,
    subset.condition = NULL,
    na.action = na.omit,
    outcome.type = NULL,
    code.event1 = 1,
    code.event2 = 2,
    code.censoring = 0,
    survfit.info = NULL,
    axis.info = NULL,
    visual.info = NULL,
    panel.info = NULL,
    style.info = NULL,
    ggsave.info = NULL,
    ...
) {
  dots <- list(...)

  if (!inherits(formula, "formula")) {
    warning("panel.per.variable=TRUE requires a formula; falling back to single-plot.")
    return(NULL)
  }
  if (is.null(data)) {
    warning("panel.per.variable=TRUE requires `data`; falling back to single-plot.")
    return(NULL)
  }

  tt   <- terms(formula)
  vars <- attr(tt, "term.labels")

  if (length(vars) <= 1L) {
    return(NULL)
  }

  if (is.null(outcome.type)) {
    outcome.type <- util_check_outcome_type_for_analysis(
      formula      = formula,
      data         = data,
      subset.condition = subset.condition,
      na.action    = na.action,
      weights      = weights,
      auto_message = FALSE
    )
  }

  lhs_chr  <- deparse(formula[[2L]])
  formulas <- lapply(vars, function(v) as.formula(paste0(lhs_chr, " ~ ", v)))
  K        <- length(formulas)

  if (identical(outcome.type, "competing-risk")) {
    code.events <- rep(list(c(code.event1, code.event2, code.censoring)), K)
  } else {
    code.events <- rep(list(c(code.event1, code.censoring)), K)
  }

  panel.info <- panel.info %||% list()
  if (is.null(panel.info$rows.columns.panel)) {
    ncol <- ceiling(sqrt(K))
    nrow <- ceiling(K / ncol)
    panel.info$rows.columns.panel <- c(nrow, ncol)
  }
  panel.info$panel.per.variable   <- FALSE
  panel.info$panel.per.event <- FALSE
  panel.info$panel.censoring <- FALSE
  if (is.null(panel.info$title.plot)) {
    panel.info$title.plot <- vars
  }

  if (is.null(dots$legend.collect)) dots$legend.collect <- TRUE
  if (is.null(dots$print.panel))    dots$print.panel    <- FALSE

  res <- do.call(
    cifpanel,
    c(list(
      formulas         = formulas,
      data             = data,
      weights          = weights,
      subset.condition = subset.condition,
      na.action        = na.action,
      outcome.type     = outcome.type,
      code.events      = code.events,
      survfit.info     = survfit.info,
      axis.info        = axis.info,
      visual.info      = visual.info,
      panel.info       = panel.info,
      style.info       = style.info,
      ggsave.info      = ggsave.info
    ), dots)
  )

  if (is.list(res) && !is.null(res$patchwork)) {
    return(res)
  }
  res
}

plot_panel.per.event <- function(
    formula,
    data,
    weights,
    axis.info,
    visual.info,
    panel.info,
    style.info,
    ggsave.info,
    survfit.info,
    dots,
    code.event1,
    code.event2,
    code.censoring,
    outcome.type,
    n.risk.type,
    rows.columns.panel,
    subset.condition = NULL,
    na.action = na.omit
) {
  if (is.null(outcome.type) || outcome.type != "competing-risk") {
    warning("panel.per.event=TRUE is only for COMPETING-RISK; falling back to single-plot.")
    return(NULL)
  }

  ce_panel <- plot_check_code_events(c(code.event1, code.event2, code.censoring))

  if (!is.null(dots$title.plot)) dots$title.plot <- NULL
  if (!is.null(dots$label.y)) dots$label.y <- NULL
  ylabs_vec <- c("Cumulative incidence of interest", "Cumulative incidence of competing risk")

  axis.info.panel <- panel_modify_list(axis.info, list(
    label.y      = ylabs_vec,
    label.strata = axis.info$label.strata,
    order.strata = axis.info$order.strata,
    level.strata = axis.info$level.strata
  ))

  visual.info.panel <- panel_modify_list(visual.info, list(
  ))

  panel.info.panel <- panel_modify_list(panel.info, list(
    rows.columns.panel = if (is.null(rows.columns.panel)) c(1L, 2L) else rows.columns.panel
  ))

  style_cur     <- style.info$style
  palette_cur   <- style.info$palette
  linewidth_cur <- style.info$linewidth
  linetype_cur  <- style.info$linetype
  ff_cur        <- style.info$font.family
  fs_cur        <- style.info$font.size
  lg_cur        <- style.info$legend.position

  ggsave.info.panel <- panel_modify_list(ggsave.info, list(
  ))

  panel_args  <- list(
    formula           = formula,
    data              = data,
    weights           = weights,
    subset.condition  = subset.condition,
    na.action         = na.action,
    outcome.type      = "competing-risk",
    code.events       = list(ce_panel, c(ce_panel[2L], ce_panel[1L], ce_panel[3L])),
    n.risk.type       = n.risk.type,
    axis.info         = axis.info.panel,
    visual.info       = visual.info.panel,
    panel.info        = panel.info.panel,
    style.info        = list(
      style           = style_cur,
      palette         = palette_cur,
      linewidth       = linewidth_cur,
      linetype        = linetype_cur,
      font.family     = ff_cur,
      font.size       = fs_cur,
      legend.position = lg_cur
    ),
    ggsave.info       = ggsave.info.panel,
    survfit.info      = survfit.info
  )

  if (is.null(dots$rows.columns.panel)) dots$rows.columns.panel <- panel.info.panel$rows.columns.panel
  if (is.null(dots$legend.collect))     dots$legend.collect     <- TRUE
  if (is.null(dots$print.panel))        dots$print.panel        <- FALSE
  dots$visual.info <- NULL

  panel_out <- do.call(cifpanel, c(panel_args, dots))

  if (is.list(panel_out) && !is.null(panel_out$patchwork)) {
    return(panel_out)
  }
  panel_out
}

plot_panel.censoring <- function(
    formula,
    data,
    weights,
    axis.info,
    visual.info,
    panel.info,
    style.info,
    ggsave.info,
    survfit.info,
    dots,
    code.event1,
    code.event2,
    code.censoring,
    outcome.type,
    n.risk.type,
    rows.columns.panel,
    subset.condition = NULL,
    na.action = na.omit
) {
  if (is.null(outcome.type) || outcome.type != "survival") {
    warning("panel.censoring=TRUE is only for SURVIVAL outcome; falling back to single-plot.")
    return(NULL)
  }

  if (!is.null(dots$title.plot)) dots$title.plot <- NULL

  ylabs_vec <- c("Survival for event of interest", "Survival with censoring as event")

  axis.info.panel <- panel_modify_list(axis.info, list(
    label.y      = ylabs_vec,
    label.strata = axis.info$label.strata,
    order.strata = axis.info$order.strata,
    level.strata = axis.info$level.strata
  ))

  panel.info.panel <- panel_modify_list(panel.info, list(
    rows.columns.panel = if (is.null(rows.columns.panel)) c(1L, 2L) else rows.columns.panel
  ))

  panel_args  <- list(
    formula           = formula,
    data              = data,
    weights           = weights,
    subset.condition  = subset.condition,
    na.action         = na.action,
    outcome.type      = "survival",
    code.events       = list(
      c(code.event1,    code.censoring),
      c(code.censoring, code.event1)
    ),
    n.risk.type       = n.risk.type,
    axis.info         = axis.info.panel,
    visual.info       = visual.info,
    panel.info        = panel.info.panel,
    style.info        = style.info,
    ggsave.info       = ggsave.info,
    survfit.info      = survfit.info
  )

  if (is.null(dots$rows.columns.panel)) dots$rows.columns.panel <- panel.info.panel$rows.columns.panel
  if (is.null(dots$legend.collect))     dots$legend.collect     <- TRUE
  if (is.null(dots$print.panel))        dots$print.panel        <- FALSE
  dots$visual.info <- NULL

  panel_out <- do.call(cifpanel, c(panel_args, dots))

  if (is.list(panel_out) && !is.null(panel_out$patchwork)) {
    return(panel_out)
  }
  panel_out
}

cifplot_single <- function(
    formula_or_fit,
    data             = NULL,
    weights          = NULL,
    subset.condition = NULL,
    na.action        = na.omit,
    outcome.type     = "competing-risk",
    code.event1      = 1,
    code.event2      = 2,
    code.censoring   = 0,
    code.events      = NULL,
    n.risk.type      = NULL,
    survfit.info     = NULL,
    axis.info        = NULL,
    visual.info      = NULL,
    panel.info       = NULL,
    style.info       = NULL,
    ggsave.info      = NULL,
    ...
) {
  panel.info <- panel.info %||% list()
  n_panel_flags <- sum(isTRUE(panel.info$panel.per.variable), isTRUE(panel.info$panel.per.event), isTRUE(panel.info$panel.censoring))
  .assert(n_panel_flags <= 1,
          "incompatible_flags",
          which = "panel.per.variable, panel.per.event, panel.censoring")

  n.risk.type.missing <- missing(n.risk.type)
  dots         <- list(...)

  survfit.info <- survfit.info %||% list()
  axis.info    <- axis.info    %||% list()
  visual.info  <- visual.info  %||% list()
  panel.info   <- panel.info   %||% list()
  style.info   <- style.info   %||% list()
  ggsave.info  <- ggsave.info  %||% list()

  if (!is.list(survfit.info)) survfit.info <- list(value = survfit.info)
  if (!is.list(axis.info))    axis.info    <- list(value = axis.info)
  if (!is.list(visual.info))  visual.info  <- list(value = visual.info)
  if (!is.list(panel.info))   panel.info   <- list(value = panel.info)
  if (!is.list(style.info))   style.info   <- list(style = style.info)
  if (!is.list(ggsave.info))  ggsave.info  <- list(value = ggsave.info)

  if (!is.null(dots$style)) {
    style.info$style <- dots$style
    dots$style <- NULL
  }
  if (!is.null(dots$palette)) {
    style.info$palette <- dots$palette
    dots$palette <- NULL
  }
  if (!is.null(dots$linewidth)) {
    style.info$linewidth <- dots$linewidth
    dots$linewidth <- NULL
  }
  if (!is.null(dots$linetype)) {
    style.info$linetype <- dots$linetype
    dots$linetype <- NULL
  }
  if (!is.null(dots$font.family)) {
    style.info$font.family <- dots$font.family
    dots$font.family <- NULL
  }
  if (!is.null(dots$font.size)) {
    style.info$font.size <- dots$font.size
    dots$font.size <- NULL
  }
  if (!is.null(dots$legend.position)) {
    style.info$legend.position <- dots$legend.position
    dots$legend.position <- NULL
  }

  survfit.info <- panel_modify_list(list(
    error     = NULL,
    conf.type = "arcsine-square root",
    conf.int  = 0.95,
    n.risk.type = n.risk.type
  ), survfit.info)

  axis.info <- panel_modify_list(list(
    type.y            = NULL,
    label.x           = "Time",
    label.y           = NULL,
    label.strata      = NULL,
    level.strata      = NULL,
    order.strata      = NULL,
    limits.x          = NULL,
    limits.y          = NULL,
    breaks.x          = NULL,
    breaks.y          = NULL,
    use.coord.cartesian = FALSE
  ), axis.info)

  visual.info <- panel_modify_list(list(
    add.conf         = TRUE,
    add.risktable                  = FALSE,
    add.estimate.table              = FALSE,
    symbol.risk.table              = "square",
    font.size.risk.table           = 3,
    add.censor.mark                 = TRUE,
    shape.censor.mark             = 3,
    size.censor.mark              = 2,
    add.competing.risk.mark          = FALSE,
    competing.risk.time           = list(),
    shape.competing.risk.mark     = 16,
    size.competing.risk.mark      = 2,
    add.intercurrent.event.mark      = FALSE,
    intercurrent.event.time       = list(),
    shape.intercurrent.event.mark = 1,
    size.intercurrent.event.mark  = 2,
    add.quantile               = FALSE,
    level.quantile                      = 0.5
  ), visual.info)

  panel.info <- panel_modify_list(list(
    panel.per.event     = FALSE,
    panel.censoring     = FALSE,
    panel.per.variable       = FALSE,
    rows.columns.panel = NULL
  ), panel.info)

  style.info <- panel_modify_list(list(
    style           = "classic",
    palette         = NULL,
    linewidth       = 0.8,
    linetype        = FALSE,
    font.family     = "sans",
    font.size       = 12,
    legend.position = "top"
  ), style.info)

  ggsave.info <- panel_modify_list(list(
    filename.ggsave = NULL,
    width.ggsave    = 6,
    height.ggsave   = 6,
    dpi.ggsave      = 300,
    units           = "in"
  ), ggsave.info)

  error     <- survfit.info$error
  conf.type <- survfit.info$conf.type
  conf.int  <- survfit.info$conf.int
  n.risk.type      <- survfit.info$n.risk.type %||% n.risk.type

  type.y              <- axis.info$type.y
  label.x             <- axis.info$label.x
  label.y             <- axis.info$label.y
  label.strata        <- axis.info$label.strata
  level.strata        <- axis.info$level.strata
  order.strata        <- axis.info$order.strata
  limits.x            <- axis.info$limits.x
  limits.y            <- axis.info$limits.y
  breaks.x            <- axis.info$breaks.x
  breaks.y            <- axis.info$breaks.y
  use.coord.cartesian <- isTRUE(axis.info$use.coord.cartesian)

  add.conf        <- visual.info$add.conf
  add.risktable                 <- visual.info$add.risktable
  add.estimate.table             <- visual.info$add.estimate.table
  symbol.risk.table             <- visual.info$symbol.risk.table
  font.size.risk.table          <- visual.info$font.size.risk.table
  add.censor.mark                <- visual.info$add.censor.mark
  shape.censor.mark            <- visual.info$shape.censor.mark
  size.censor.mark             <- visual.info$size.censor.mark
  add.competing.risk.mark         <- visual.info$add.competing.risk.mark
  competing.risk.time          <- visual.info$competing.risk.time
  shape.competing.risk.mark    <- visual.info$shape.competing.risk.mark
  size.competing.risk.mark     <- visual.info$size.competing.risk.mark
  add.intercurrent.event.mark     <- visual.info$add.intercurrent.event.mark
  intercurrent.event.time      <- visual.info$intercurrent.event.time
  shape.intercurrent.event.mark<- visual.info$shape.intercurrent.event.mark
  size.intercurrent.event.mark <- visual.info$size.intercurrent.event.mark
  add.quantile              <- visual.info$add.quantile
  level.quantile                     <- visual.info$level.quantile

  panel.per.event     <- isTRUE(panel.info$panel.per.event)
  panel.censoring     <- isTRUE(panel.info$panel.censoring)
  panel.per.variable       <- isTRUE(panel.info$panel.per.variable)
  rows.columns.panel <- panel.info$rows.columns.panel

  style           <- style.info$style
  palette         <- style.info$palette
  linewidth       <- style.info$linewidth
  linetype        <- style.info$linetype
  font.family     <- style.info$font.family
  font.size       <- style.info$font.size
  legend.position <- style.info$legend.position

  filename.ggsave <- ggsave.info$filename.ggsave
  width.ggsave    <- ggsave.info$width.ggsave
  height.ggsave   <- ggsave.info$height.ggsave
  dpi.ggsave      <- ggsave.info$dpi.ggsave
  ggsave.units    <- ggsave.info$units %||% "in"

  level_input     <- axis.info$level.strata
  order_input     <- axis.info$order.strata

  norm <- normalize_strata_info(
    level.strata = axis.info$level.strata,
    label.strata = axis.info$label.strata,
    order.strata = axis.info$order.strata
  )

  axis.info$level.strata <- norm$level
  axis.info$order.strata <- norm$order_data
  axis.info$label.strata <- norm$label_map

  if (!is.null(axis.info$label.strata)) {
    stopifnot(!is.null(names(axis.info$label.strata)))
  }
  if (!is.null(order_input) && !is.null(level_input)) {
    if (!all(as.character(order_input) %in% as.character(level_input))) {
      warning("order.strata has unknown levels; ignoring order/label application.")
      axis.info$order.strata <- NULL
      axis.info$label.strata <- NULL
    }
  }
  level.strata <- axis.info$level.strata
  label.strata <- axis.info$label.strata
  order.strata <- axis.info$order.strata

  if (is.null(outcome.type)) {
    outcome.type <- util_check_outcome_type_for_analysis(
      formula = if (inherits(formula_or_fit, "survfit")) NULL else formula_or_fit,
      data = data,
      subset.condition = subset.condition,
      na.action = na.action,
      weights = weights,
      auto_message = FALSE
    )
  } else {
    outcome.type <- match.arg(outcome.type, c("competing-risk","survival"))
  }
  survfit.info$outcome.type <- outcome.type
  if (inherits(formula_or_fit, "survfit")) {
    n.risk.type <- formula_or_fit$n.risk.type %||% n.risk.type
    if (is.null(n.risk.type)) n.risk.type <- util_check_n_risk_type(n.risk.type)
  } else {
    n.risk.type <- util_check_n_risk_type(n.risk.type)
  }
  survfit.info$n.risk.type <- survfit.info$n.risk.type %||% n.risk.type

  if (!inherits(formula_or_fit, "survfit")) {
    if (is.null(data)) stop("When `formula` is a formula, `data` must be provided.")
    norm_inputs <- plot_normalize_formula_data(
      formula_or_fit,
      data,
      subset.condition = subset.condition,
      na.action = na.action
    )
    data_working <- norm_inputs$data

    # Forward the resolved value, even if data contains a column named weights.
    formula_or_fit <- cifcurve(formula_or_fit, data = data_working, weights = identity(weights), subset.condition = subset.condition, na.action = na.action,
                               outcome.type = outcome.type, code.event1 = code.event1, code.event2 = code.event2, code.censoring = code.censoring,
                               error = error, conf.type = conf.type, conf.int = conf.int, n.risk.type = n.risk.type)
    formula_or_fit <- plot_survfit_short_strata_names(formula_or_fit)
  }

  eps <- if (!is.null(axis.info$type.y) && axis.info$type.y %in% c("cumhaz", "cloglog")) 1e-12 else 0
  formula_or_fit$surv  <- plot_clamp01(formula_or_fit$surv,  eps = eps)
  formula_or_fit$lower <- plot_clamp01(formula_or_fit$lower, eps = eps)
  formula_or_fit$upper <- plot_clamp01(formula_or_fit$upper, eps = eps)

  p <- call_ggsurvfit(
    survfit_object = formula_or_fit,
    out_read_surv  = NULL,
    survfit.info   = survfit.info,
    axis.info      = axis.info,
    visual.info    = visual.info,
    panel.info     = panel.info,
    style.info     = style.info,
    ggsave.info    = ggsave.info
  )
  p <- plot_apply_y_axis_controls(
    p,
    limits.y = limits.y,
    breaks.y = breaks.y,
    use.coord.cartesian = use.coord.cartesian
  )
  if (!is.null(filename.ggsave)) ggplot2::ggsave(filename.ggsave, plot = p, width = width.ggsave, height = height.ggsave, dpi = dpi.ggsave, units = ggsave.units)
  attr(p, "cifmodeling_survfit") <- formula_or_fit
  return(p)
}

#' Plot survival or cumulative incidence curves with ggsurvfit
#'
#' @param survfit_object A \code{survfit} object.
#' @param out_read_surv (optional) List returned by your \code{util_read_surv()} to auto-set x limits.
#' @param conf.type Character transformation for CI on the probability scale (default \code{"arcsine-square root"}).

#' @param add.conf Logical add \code{add_confidence_interval()} to plot. It calls geom_ribbon() (default \code{TRUE}).
#' @param add.risktable Logical add \code{add_risktable(risktable_stats="n.risk")} to plot (default \code{TRUE}).
#' @param add.estimate.table Logical add \code{add_risktable(risktable_stats="estimate (conf.low, conf.high)")} to plot (default \code{FALSE}).
#' @param add.censor.mark Logical add \code{add_censor_mark()} to plot. It calls geom_point() (default \code{TRUE}).
#' @param shape.censor.mark Integer point shape for censor marks (default \code{3}).
#' @param size.censor.mark Numeric point size for censor marks (default \code{2}).
#' @param add.competing.risk.mark Logical add time marks to describe event2 specified by Event(), usually the competing events. It calls geom_point() (default \code{TRUE}).
#' @param competing.risk.time Named list of numeric vectors (names must be mapped to strata labels).
#' @param shape.competing.risk.mark Integer point shape for competing-risk marks (default \code{16}).
#' @param size.competing.risk.mark Numeric point size for competing-risk marks (default \code{2}).
#' @param add.intercurrent.event.mark Logical overlay user-specified time marks per strata calls geom_point() (default \code{TRUE}).
#' @param intercurrent.event.time Named list of numeric vectors (names must be mapped to strata labels).
#' @param shape.intercurrent.event.mark Integer point shape for intercurrent-event marks (default \code{1}).
#' @param size.intercurrent.event.mark Numeric point size for intercurrent-event marks (default \code{2}).
#' @param add.quantile Logical add \code{add_quantile()} to plot. It calls geom_segment() (default \code{TRUE}).
#' @param level.quantile Numeric quantile level passed to \code{add_quantile()} (default \code{0.5}).

#' @param type.y \code{NULL} (survival) or \code{"risk"} (display \code{1 - survival} i.e. CIF).
#' @param label.x Character x-axis labels (default \code{"Time"}).
#' @param label.y Character y-axis labels (default internally set to \code{"Survival"} or \code{"Cumulative incidence"}).
#' @param label.strata Character vector of labels for strata.

#' @param limits.x Numeric length-2 vectors for axis limits. If NULL it is internally set to \code{c(0,max(out_read_surv$t))}.
#' @param limits.y Numeric length-2 vectors for axis limits. If NULL it is internally set to \code{c(0,1)}.
#' @param breaks.x Numeric vectors for axis breaks (default \code{NULL}).
#' @param breaks.y Numeric vectors for axis breaks (default \code{NULL}).
#' @param use.coord.cartesian Logical specify use of coord_cartesian() (default \code{FALSE}).

#' @param style Character plot theme controls (default \code{"classic"}).
#' @param font.family Character plot theme controls (default \code{"sans"}).
#' @param font.size Integer plot theme controls (default \code{14}).
#' @param legend.position Character specify position of legend: \code{"top"}, \code{"right"}, \code{"bottom"}, \code{"left"}, or \code{"none"} (default \code{"top"}).

#' @return A \code{ggplot} object.
#' @keywords internal
#' @noRd
call_ggsurvfit <- function(
    survfit_object,
    out_read_surv = NULL,
    survfit.info  = NULL,
    axis.info     = NULL,
    visual.info   = NULL,
    panel.info    = NULL,
    style.info    = NULL,
    ggsave.info   = NULL
){
  survfit.info        <- survfit.info %||% list()
  axis.info           <- axis.info    %||% list()
  visual.info         <- visual.info  %||% list()
  panel.info          <- panel.info   %||% list()
  style.info          <- style.info   %||% list()
  ggsave.info         <- ggsave.info  %||% list()

  type.y              <- axis.info$type.y
  label.x.user        <- axis.info$label.x
  label.y.user        <- axis.info$label.y
  label.strata        <- axis.info$label.strata
  level.strata        <- axis.info$level.strata
  order.strata        <- axis.info$order.strata
  limits.x            <- axis.info$limits.x
  limits.y            <- axis.info$limits.y
  breaks.x            <- axis.info$breaks.x
  breaks.y            <- axis.info$breaks.y
  use.coord.cartesian <- isTRUE(axis.info$use.coord.cartesian)

  add.conf                      <- visual.info$add.conf
  add.risktable                 <- visual.info$add.risktable
  add.estimate.table            <- visual.info$add.estimate.table
  symbol.risk.table             <- visual.info$symbol.risk.table
  font.size.risk.table          <- visual.info$font.size.risk.table
  add.censor.mark               <- visual.info$add.censor.mark
  shape.censor.mark             <- visual.info$shape.censor.mark
  size.censor.mark              <- visual.info$size.censor.mark
  add.competing.risk.mark       <- visual.info$add.competing.risk.mark
  competing.risk.time           <- visual.info$competing.risk.time
  shape.competing.risk.mark     <- visual.info$shape.competing.risk.mark
  size.competing.risk.mark      <- visual.info$size.competing.risk.mark
  add.intercurrent.event.mark   <- visual.info$add.intercurrent.event.mark
  intercurrent.event.time       <- visual.info$intercurrent.event.time
  shape.intercurrent.event.mark <- visual.info$shape.intercurrent.event.mark
  size.intercurrent.event.mark  <- visual.info$size.intercurrent.event.mark
  add.quantile                  <- visual.info$add.quantile
  level.quantile                <- visual.info$level.quantile

  style              <- style.info$style
  palette            <- style.info$palette
  linewidth          <- style.info$linewidth
  linetype           <- style.info$linetype
  font.family        <- style.info$font.family
  font.size          <- style.info$font.size
  legend.position    <- style.info$legend.position

  if (!identical(legend.position, "none")) {
    label.strata.map <- plot_make_label.strata.map(
      survfit_object = survfit_object,
      label.strata   = label.strata,
      level.strata   = level.strata
    )
    res <- plot_reconcile_order_and_labels(
      survfit_object   = survfit_object,
      label.strata.map = label.strata.map,
      level.strata     = level.strata,
      order.strata     = order.strata
    )
    limits_arg          <- res$limits_arg
    strata_levels_final <- res$strata_levels_final
    strata_labels_final <- res$strata_labels_final
    n_strata_effective  <- length(limits_arg)
  } else {
    limits_arg          <- NULL
    strata_levels_final <- NULL
    strata_labels_final <- NULL
    n_strata_effective  <- NULL
  }

  out_cg <- check_ggsurvfit(
    survfit_object  = survfit_object,
    survfit.info    = survfit.info,
    axis.info       = axis.info,
    visual.info     = visual.info,
    style.info      = style.info,
    out_read_surv   = out_read_surv
  )

  type_y_eff <- out_cg$type.y
  is_cloglog <- identical(type_y_eff, "cloglog") || identical(type.y, "cloglog")

  p <- out_cg$out_survfit_object +
    ggplot2::labs(
      x = label.x.user %||% "Time",
      y = label.y.user %||% out_cg$label.y
    )

  if (!isTRUE(is_cloglog)) {
    if (isTRUE(add.conf)) {
      p <- p + add_confidence_interval()
    }
    if (isTRUE(add.censor.mark)) {
      p <- p + add_censor_mark(shape = shape.censor.mark, size = size.censor.mark)
    }
    if (isTRUE(add.quantile)) {
      p <- p + add_quantile(y_value = level.quantile)
    }

    has_strata <- !is.null(survfit_object$strata) && length(survfit_object$strata) > 1L
    apply_add_risktable_strata_symbol <- function (p, symbol.risk.table, has_strata) {
      if (!isTRUE(has_strata)) return(p)
      if (symbol.risk.table=="square")   p <- p + add_risktable_strata_symbol(symbol = "\U25A0", size = 14)
      if (symbol.risk.table=="circle")   p <- p + add_risktable_strata_symbol(symbol = "\U25CF", size = 14)
      if (symbol.risk.table=="triangle") p <- p + add_risktable_strata_symbol(symbol = "\U25B2", size = 14)
      p
    }

    if (isTRUE(add.estimate.table) && isTRUE(add.risktable)) {
      p <- p + add_risktable(
        risktable_stats = c(
          "{ceiling(n.risk)}",
          "{round(estimate, digits=2)} ({round(conf.low, digits=2)}, {round(conf.high, digits=2)})"
        ),
        stats_label     = c("No. at risk", "Estimate (95% CI)"),
        theme           = plot_theme_risktable_font(font.family = font.family, plot.title.size = font.size),
        risktable_group = "risktable_stats",
        size            = font.size.risk.table
      )
      p <- apply_add_risktable_strata_symbol(p, symbol.risk.table, has_strata)
    } else if (isTRUE(add.estimate.table)) {
      p <- p + add_risktable(
        risktable_stats = c("{round(estimate, digits=2)} ({round(conf.low, digits=2)}, {round(conf.high, digits=2)})"),
        stats_label     = c("Estimate (95% CI)"),
        theme           = plot_theme_risktable_font(font.family = font.family, plot.title.size = font.size),
        risktable_group = "risktable_stats",
        size            = font.size.risk.table
      )
      p <- apply_add_risktable_strata_symbol(p, symbol.risk.table, has_strata)
    } else if (isTRUE(add.risktable)) {
      p <- p + add_risktable(
        risktable_stats = c("{ceiling(n.risk)}"),
        stats_label     = c("No. at risk"),
        theme           = plot_theme_risktable_font(font.family = font.family, plot.title.size = font.size),
        risktable_group = "risktable_stats",
        size            = font.size.risk.table
      )
      p <- apply_add_risktable_strata_symbol(p, symbol.risk.table, has_strata)
    }

    if (isTRUE(add.competing.risk.mark) && length(competing.risk.time)>0) {
      p <- plot_draw_marks(
        p, survfit_object,
        competing.risk.time, type_y_eff,
        shape = shape.competing.risk.mark,
        size  = size.competing.risk.mark
      )
    }
    if (isTRUE(add.intercurrent.event.mark) && length(intercurrent.event.time)>0) {
      p <- plot_draw_marks(
        p, survfit_object,
        intercurrent.event.time, type_y_eff,
        shape = shape.intercurrent.event.mark,
        size  = size.intercurrent.event.mark
      )
    }
  }

  if (!identical(style, "ggsurvfit")) {
    p <- plot_apply_style(
      p,
      style               = style,
      font.family         = font.family,
      font.size           = font.size,
      legend.position     = legend.position,
      n_strata            = n_strata_effective,
      palette_colors      = palette,
      strata_levels_final = strata_levels_final,
      strata_labels_final = strata_labels_final
    )
  }
  p <- plot_apply_all_scales(
    p,
    style               = style,
    palette             = palette,
    n_strata            = n_strata_effective,
    strata_levels_final = strata_levels_final,
    strata_labels_final = strata_labels_final,
    limits_arg          = limits_arg
  )

  p <- apply_axis_limits_breaks(
    p,
    type_y_eff          = type_y_eff,
    survfit_object      = survfit_object,
    limits.x            = limits.x,
    limits.y            = limits.y,
    breaks.x            = breaks.x,
    breaks.y            = breaks.y,
    use.coord.cartesian = use.coord.cartesian
  )

  # 5) guides / palette fix
  p <- p +
    ggplot2::guides(fill = "none", alpha = "none", shape = "none") +
    ggplot2::guides(colour = ggplot2::guide_legend(override.aes = list(fill = NA)))
  p <- plot_fix_palette_vector_arg(p)
  return(p)
}


call_ggsurvfit_old <- function(
    survfit_object,
    out_read_surv = NULL,
    survfit.info  = NULL,
    axis.info     = NULL,
    visual.info   = NULL,
    panel.info    = NULL,
    style.info    = NULL,
    ggsave.info   = NULL
){
  survfit.info        <- survfit.info %||% list()
  axis.info           <- axis.info    %||% list()
  visual.info         <- visual.info  %||% list()
  panel.info          <- panel.info   %||% list()
  style.info          <- style.info   %||% list()
  ggsave.info         <- ggsave.info  %||% list()

  error               <- survfit.info$error
  conf.type           <- survfit.info$conf.type
  conf.int            <- survfit.info$conf.int

  type.y              <- axis.info$type.y
  label.x.user        <- axis.info$label.x
  label.y.user        <- axis.info$label.y
  label.strata        <- axis.info$label.strata
  level.strata        <- axis.info$level.strata
  order.strata        <- axis.info$order.strata
  limits.x            <- axis.info$limits.x
  limits.y            <- axis.info$limits.y
  breaks.x            <- axis.info$breaks.x
  breaks.y            <- axis.info$breaks.y
  use.coord.cartesian <- isTRUE(axis.info$use.coord.cartesian)

  add.conf                      <- visual.info$add.conf
  add.risktable                 <- visual.info$add.risktable
  add.estimate.table            <- visual.info$add.estimate.table
  symbol.risk.table             <- visual.info$symbol.risk.table
  font.size.risk.table          <- visual.info$font.size.risk.table
  add.censor.mark               <- visual.info$add.censor.mark
  shape.censor.mark             <- visual.info$shape.censor.mark
  size.censor.mark              <- visual.info$size.censor.mark
  add.competing.risk.mark       <- visual.info$add.competing.risk.mark
  competing.risk.time           <- visual.info$competing.risk.time
  shape.competing.risk.mark     <- visual.info$shape.competing.risk.mark
  size.competing.risk.mark      <- visual.info$size.competing.risk.mark
  add.intercurrent.event.mark   <- visual.info$add.intercurrent.event.mark
  intercurrent.event.time       <- visual.info$intercurrent.event.time
  shape.intercurrent.event.mark <- visual.info$shape.intercurrent.event.mark
  size.intercurrent.event.mark  <- visual.info$size.intercurrent.event.mark
  add.quantile                  <- visual.info$add.quantile
  level.quantile                <- visual.info$level.quantile

  panel.per.event               <- isTRUE(panel.info$panel.per.event)
  panel.censoring               <- isTRUE(panel.info$panel.censoring)
  panel.per.variable            <- isTRUE(panel.info$panel.per.variable)

  style              <- style.info$style
  palette            <- style.info$palette
  linewidth          <- style.info$linewidth
  linetype           <- style.info$linetype
  font.family        <- style.info$font.family
  font.size          <- style.info$font.size
  legend.position    <- style.info$legend.position

  filename.ggsave    <- ggsave.info$filename.ggsave
  width.ggsave       <- ggsave.info$width.ggsave
  height.ggsave      <- ggsave.info$height.ggsave
  dpi.ggsave         <- ggsave.info$dpi.ggsave
  ggsave.units       <- ggsave.info$units %||% "in"

  if (!identical(legend.position, "none")) {
    label.strata.map <- plot_make_label.strata.map(
      survfit_object = survfit_object,
      label.strata   = label.strata,
      level.strata   = level.strata
    )
    res <- plot_reconcile_order_and_labels(
      survfit_object   = survfit_object,
      label.strata.map = label.strata.map,
      level.strata     = level.strata,
      order.strata     = order.strata
    )
    limits_arg          <- res$limits_arg
    label.strata.map    <- res$label.strata.map
    strata_levels_final <- res$strata_levels_final
    strata_labels_final <- res$strata_labels_final
    n_strata_effective  <- length(limits_arg)
  } else {
    limits_arg          <- NULL
    label.strata.map    <- NULL
    strata_levels_final <- NULL
    strata_labels_final <- NULL
    n_strata_effective  <- NULL
  }

  out_cg <- check_ggsurvfit(
    survfit_object  = survfit_object,
    survfit.info    = survfit.info,
    axis.info       = axis.info,
    visual.info     = visual.info,
    style.info      = style.info,
    out_read_surv   = out_read_surv
  )
  p <- out_cg$out_survfit_object +
    ggplot2::labs(
      x = label.x.user %||% "Time",
      y = label.y.user %||% out_cg$label.y
    )

  if (isTRUE(add.conf)) {
    p <- p + add_confidence_interval()
  }
  if (isTRUE(add.censor.mark)) {
    p <- p + add_censor_mark(shape = shape.censor.mark, size = size.censor.mark)
  }
  if (isTRUE(add.quantile)) {
    p <- p + add_quantile(y_value = level.quantile)
  }

  apply_add_risktable_strata_symbol <- function (p, symbol.risk.table, has_strata) {
    if (!isTRUE(has_strata)) return(p)
    if (symbol.risk.table=="square") {
      p <- p + add_risktable_strata_symbol(symbol = "\U25A0", size = 14)
    } else if (symbol.risk.table=="circle") {
      p <- p + add_risktable_strata_symbol(symbol = "\U25CF", size = 14)
    } else if (symbol.risk.table=="triangle") {
      p <- p + add_risktable_strata_symbol(symbol = "\U25B2", size = 14)
    }
    return(p)
  }
  has_strata <- !is.null(survfit_object$strata) && length(survfit_object$strata) > 1L

  if (isTRUE(add.estimate.table) && isTRUE(add.risktable)) {
    p <- p + add_risktable(
      risktable_stats = c("{ceiling(n.risk)}", "{round(estimate, digits=2)} ({round(conf.low, digits=2)}, {round(conf.high, digits=2)})"),
      stats_label     = c("No. at risk", "Estimate (95% CI)"),
      theme           = plot_theme_risktable_font(font.family = font.family, plot.title.size = font.size),
      risktable_group = "risktable_stats",
      size            = font.size.risk.table
    )
    p <- apply_add_risktable_strata_symbol(p, symbol.risk.table, has_strata)
  } else if (isTRUE(add.estimate.table)) {
    p <- p + add_risktable(
      risktable_stats = c("{round(estimate, digits=2)} ({round(conf.low, digits=2)}, {round(conf.high, digits=2)})"),
      stats_label     = c("Estimate (95% CI)"),
      theme           = plot_theme_risktable_font(font.family = font.family, plot.title.size = font.size),
      risktable_group = "risktable_stats",
      size            = font.size.risk.table
    )
    p <- apply_add_risktable_strata_symbol(p, symbol.risk.table, has_strata)
  } else if (isTRUE(add.risktable)) {
    p <- p + add_risktable(
      #risktable_stats = c("n.risk"),
      risktable_stats = c("{ceiling(n.risk)}"),
      stats_label     = c("No. at risk"),
      theme           = plot_theme_risktable_font(font.family = font.family, plot.title.size = font.size),
      risktable_group = "risktable_stats",
      size            = font.size.risk.table
    )
    p <- apply_add_risktable_strata_symbol(p, symbol.risk.table, has_strata)
  }

  if (isTRUE(add.competing.risk.mark) && length(competing.risk.time)>0) {
    p <- plot_draw_marks(
      p, survfit_object,
      competing.risk.time, out_cg$type.y,
      shape = shape.competing.risk.mark,
      size  = size.competing.risk.mark
    )
  }
  if (isTRUE(add.intercurrent.event.mark) && length(intercurrent.event.time)>0) {
    p <- plot_draw_marks(
      p, survfit_object,
      intercurrent.event.time, out_cg$type.y,
      shape = shape.intercurrent.event.mark,
      size  = size.intercurrent.event.mark
    )
  }

  if (!identical(style, "ggsurvfit")) {
    p <- plot_apply_style(
      p,
      style               = style,
      font.family         = font.family,
      font.size           = font.size,
      legend.position     = legend.position,
      n_strata            = n_strata_effective,
      palette_colors      = palette,
      strata_levels_final = strata_levels_final,
      strata_labels_final = strata_labels_final
    )
  }
  p <- plot_apply_all_scales(
    p,
    style               = style,
    palette             = palette,
    n_strata            = n_strata_effective,
    strata_levels_final = strata_levels_final,
    strata_labels_final = strata_labels_final,
    limits_arg          = limits_arg
  )

  p <- apply_axis_limits_breaks(
    p,
    type_y_eff          = out_cg$type.y,
    survfit_object      = survfit_object,
    limits.x            = limits.x,
    limits.y            = limits.y,
    breaks.x            = breaks.x,
    breaks.y            = breaks.y,
    use.coord.cartesian = use.coord.cartesian
  )

  p <- p + ggplot2::guides(fill = "none", alpha = "none", shape = "none") +
    ggplot2::guides(colour = ggplot2::guide_legend(override.aes = list(fill = NA)))

  p <- plot_fix_palette_vector_arg(p)
  return(p)
}

check_ggsurvfit <- function(
    survfit_object,
    survfit.info  = NULL,
    axis.info     = NULL,
    visual.info   = NULL,
    style.info    = NULL,
    out_read_surv = NULL
){
  survfit.info <- survfit.info %||% list()
  axis.info    <- axis.info    %||% list()
  visual.info  <- visual.info  %||% list()
  style.info   <- style.info   %||% list()

  outcome.type        <- survfit.info$outcome.type %||% NULL
  conf.type           <- survfit.info$conf.type
  type.y              <- axis.info$type.y
  label.y             <- axis.info$label.y
  limits.x            <- axis.info$limits.x
  limits.y            <- axis.info$limits.y
  breaks.x            <- axis.info$breaks.x
  breaks.y            <- axis.info$breaks.y
  use.coord.cartesian <- isTRUE(axis.info$use.coord.cartesian)

  add.conf                      <- visual.info$add.conf
  add.censor.mark               <- visual.info$add.censor.mark
  add.competing.risk.mark       <- visual.info$add.competing.risk.mark
  add.intercurrent.event.mark   <- visual.info$add.intercurrent.event.mark
  shape.censor.mark             <- visual.info$shape.censor.mark
  shape.competing.risk.mark     <- visual.info$shape.competing.risk.mark
  shape.intercurrent.event.mark <- visual.info$shape.intercurrent.event.mark

  style     <- style.info$style
  palette   <- style.info$palette
  linewidth <- style.info$linewidth
  linetype  <- style.info$linetype

  if (isTRUE(add.censor.mark) && isTRUE(add.intercurrent.event.mark) &&
      identical(shape.censor.mark, shape.intercurrent.event.mark)) {
    .warn("shape_identical", a = "shape.censor.mark", b = "shape.intercurrent.event.mark")
  }
  if (isTRUE(add.censor.mark) && isTRUE(add.competing.risk.mark) &&
      identical(shape.censor.mark, shape.competing.risk.mark)) {
    .warn("shape_identical", a = "shape.censor.mark", b = "shape.competing.risk.mark")
  }
  if (isTRUE(add.competing.risk.mark) && isTRUE(add.intercurrent.event.mark) &&
      identical(shape.competing.risk.mark, shape.intercurrent.event.mark)) {
    .warn("shape_identical", a = "shape.competing.risk.mark", b = "shape.intercurrent.event.mark")
  }

  is_len2_num <- function(x) is.numeric(x) && length(x) == 2L && all(is.finite(x))
  is_nondec   <- function(x) all(diff(x) >= 0, na.rm = TRUE)

  if (!is.null(limits.x)) {
    if (!(is.numeric(limits.x) && length(limits.x) == 2L && all(is.finite(limits.x)))) {
      .warn("limits_len2", arg = "limits.x")
    } else if (!all(diff(limits.x) > 0)) {
      .warn("limits_increasing", arg = "limits.x")
    }
    tmax <- suppressWarnings(max(survfit_object$time, na.rm = TRUE))
    if (is.finite(tmax)) {
      if (tmax < limits.x[1] || tmax > limits.x[2]) {
        .warn("limits_x_outside", tmax = signif(tmax, 6), arg = "limits.x",
              a = signif(limits.x[1], 6), b = signif(limits.x[2], 6))
      }
    }
  } else if (!is.null(out_read_surv) && !is.null(out_read_surv$t)) {
    tmax <- suppressWarnings(max(out_read_surv$t, na.rm = TRUE))
    if (!is.finite(tmax) || tmax <= 0) .warn("ors_tmax_bad")
  }

  if (!is.null(limits.y)) {
    if (!(is.numeric(limits.y) && length(limits.y) == 2L && all(is.finite(limits.y)))) {
      .warn("limits_len2", arg = "limits.y")
    } else if (!all(diff(limits.y) > 0)) {
      .warn("limits_increasing", arg = "limits.y")
    }

    surv  <- survfit_object$surv
    upper <- survfit_object$upper
    lower <- survfit_object$lower

    if (identical(type.y, "risk")) {
      surv  <- 1 - surv
      if (!is.null(upper)) upper <- 1 - upper
      if (!is.null(lower)) lower <- 1 - lower
    }

    if (any(surv < limits.y[1] | surv > limits.y[2], na.rm = TRUE))
      .warn("est_outside_limits_y", arg = "limits.y", a = limits.y[1], b = limits.y[2])

    if (isTRUE(add.conf)) {
      if (!is.null(upper) && any(upper < limits.y[1] | upper > limits.y[2], na.rm = TRUE))
        .warn("upper_outside_limits_y", arg = "limits.y", a = limits.y[1], b = limits.y[2])
      if (!is.null(lower) && any(lower < limits.y[1] | lower > limits.y[2], na.rm = TRUE))
        .warn("lower_outside_limits_y", arg = "limits.y", a = limits.y[1], b = limits.y[2])
    }
  }

  check_breaks <- function(bk, nm, lims) {
    if (is.null(bk) || is.function(bk)) return(invisible())
    if (!is.numeric(bk)) {
      warning(sprintf("`%s` should be numeric (or a function).", nm), call. = FALSE); return(invisible())
    }
    if (!is_nondec(bk)) {
      warning(sprintf("`%s` must be non-decreasing.", nm), call. = FALSE)
    }
    if (!is.null(lims) && is_len2_num(lims)) {
      if (any(bk < lims[1] | bk > lims[2], na.rm = TRUE)) {
        warning(sprintf("Some `%s` are outside plotting range [%g, %g].", nm, lims[1], lims[2]), call. = FALSE)
      }
    }
    invisible()
  }
  check_breaks(breaks.x, "breaks.x", limits.x)
  check_breaks(breaks.y, "breaks.y", limits.y)

  coerce_conf <- function(survfit_object, conf.type) {
    if (!is.null(survfit_object$lower) && !is.null(survfit_object$upper)) return(survfit_object)
    if (conf.type %in% c("none", "n") || length(survfit_object$strata) > 2) {
      x <- survfit_object
      x$lower <- x$surv
      x$upper <- x$surv
      return(x)
    }
    survfit_object
  }
  survfit_object <- coerce_conf(survfit_object, conf.type)

  type.y <- util_check_type_y(
    x            = type.y,
    outcome.type = outcome.type,
    survfit_type = survfit_object$type
  )

  if (is.null(label.y)) {
    if (!is.null(type.y)) {
      label.y <- switch(
        type.y,
        surv    = "Survival",
        risk    = "Cumulative incidence",
        cumhaz  = "Cumulative hazard",
        cloglog = "Complementary log-log",
        NULL
      )
    }
    if (is.null(label.y)) {
      auto_label <- plot_default_y_label(
        fit_type = survfit_object$type,
        type.y   = type.y
      )
      if (!is.null(auto_label)) label.y <- auto_label
    }
  }
  out_plot <- ggsurvfit(
    survfit_object,
    type         = type.y,
    linewidth    = linewidth,
    linetype_aes = linetype
  )

  list(
    out_survfit_object = out_plot,
    label.y            = label.y,
    type.y             = type.y
  )
}

Try the cifmodeling package in your browser

Any scripts or data that you put into this service are public.

cifmodeling documentation built on Nov. 11, 2026, 9:06 a.m.