向 ggflexsurv 图添加阴影置信区间

问：

Survminer 包中的 ggflexsurv 似乎只支持虚线置信区间线，而不是阴影/填充线。我尝试了一些解决方法，例如这个线程，但无济于事。

我的最后一次尝试是将链接线程中答案的代码插入到 ggflexsurv 的源代码中

ggflexsurvplotmod <- function(fit, 
                               data = NULL,
                               fun = c("survival", "cumhaz"),
                               summary.flexsurv = NULL,
                               size = 1, 
                               conf.int = FALSE,
                               conf.int.flex = conf.int, 
                               conf.int.km = FALSE,
                               legend.labs = NULL,...)
  
{
  
  if (!requireNamespace("flexsurv", quietly = TRUE)){
    stop("flexsurv package needed for this function to work. Please install it.")}
  
  if(!inherits(fit, "flexsurvreg")){
    stop("Can't handle an object of class ", class(fit))
    fun <- match.arg(fun)}
  
  data <- .get_data(fit, data = data, complain = FALSE)
  
  summ <- .summary_flexsurv(fit, type = fun,
                            summary.flexsurv = summary.flexsurv)
  
  .strata <- summ$strata
  
  n.strata <- .strata %>% .levels() %>% length()
  
  fit.ext <- .extract.survfit(fit)
  
  surv.obj <- fit.ext$surv
  
  surv.vars <- fit.ext$variables
  
  .formula <- fit.ext$formula
  
  isfac <- .is_all_covariate_factor(fit)
  
  if(!all(isfac))
  {.formula <- .build_formula(surv.obj, "1")
    n.strata <- 1}
  
  if(n.strata == 1 & missing(conf.int)) conf.int <- TRUE
  
  # Fit KM survival curves
  
  #::::::::::::::::::::::::::::::::::::::
x <- do.call(survival::survfit, 
             list(formula = .formula, data = data))

fun <- if(fun == "survival") NULL else fun

ggsurv <- ggsurvplot_core(x, 
                          data = data, 
                          size = 0.5,
                          fun = fun, 
                          conf.int = conf.int.km,
                          legend.labs = legend.labs, ...)
  
  # Overlay the fitted models
  
  #::::::::::::::::::::::::::::::::::::::
  
  # Check legend labels if specified
  
  if(!is.null(legend.labs)){
    
    if(n.strata != length(legend.labs))
      stop("The length of legend.labs should be ", n.strata )
    
    summ$strata <- factor(summ$strata,
                          levels = .levels(.strata),
                          labels = legend.labs)
    
  }
  
  time <- est <- strata <- lcl <- ucl <- NULL

ggsurv$plot <- 
    ggsurv$plot +
    geom_line(aes(time, 
                  est, 
                  color = strata),
              data = summ, 
              size = size)
  
  #CODE FROM PREVIOUS STACKOVERFLOW THREAD#######
  
  stairstepn <- function( data, direction="hv", yvars="y" )
    {direction <- match.arg(direction, c("hv", "vh") )
    data <- as.data.frame(data)[ order( data$x ), ]
    n <- nrow( data )
  
  if ( direction == "vh" ) {
    xs <- rep( 1:n, each = 2 )[ -2 * n ]
    ys <- c( 1, rep( 2:n, each = 2 ) )
  } else {
    ys <- rep( 1:n, each = 2 )[ -2 * n ]
    xs <- c( 1, rep( 2:n, each = 2))
  }
  
  data.frame(
    x = data$x[ xs ]
    , data[ ys, yvars, drop=FALSE ]
    , data[ xs, setdiff( names( data ), c( "x", yvars ) ), drop=FALSE ]
  ) 
  
  }
  
  stat_stepribbon <- function(mapping = NULL, 
                              data = NULL, 
                              geom = "ribbon", 
                              position = "identity", 
                              inherit.aes = TRUE) 
  {ggplot2::layer(stat = Stepribbon, 
                    mapping = mapping, 
                  data = data, 
                  geom = geom,
                  position = position, 
                  inherit.aes = inherit.aes)}
  
  StatStepribbon <- ggproto("stepribbon", 
                            Stat,
                            compute_group = 
                              function(., data, scales, 
                                       direction = "hv",
                                       yvars = c( "ymin", "ymax" ), ...)
                                {stairstepn(data = data,
                                            direction = direction,
                                            yvars = yvars )},
                            required_aes = c( "x", "ymin", "ymax" ))
  
  ###########################################################################
  
  if(conf.int.flex) ggsurv$plot <- ggsurv$plot+
    geom_ribbon(aes(ymin = lcl,
                    ymax = ucl), 
                fill = strata, 
                stat = "stepribbon", 
                data = summ, 
                alpha=0.3)
  
  #other version of geom_ribbon() attempted
  #geom_ribbon(aes(ymin=lcl,ymax=ucl), data = summ,fill=strata, alpha=0.3) #stat="identity"
  #original code in package
  #geom_line(aes(time, lcl, color = strata), data = summ, #size = 0.5, linetype = "dashed")+
  
  #geom_line(aes(time, ucl, color = strata), data = summ, #size = 0.5, linetype = "dashed")
  
  ggsurv
  
}

.summary_flexsurv <- function(fit, type = "survival", summary.flexsurv = NULL){
  
  summ <- summary.flexsurv
  
  if(is.null(summary.flexsurv)){
    summ <- summary(fit, type = type)}
  
  if(length(summ) == 1){summ <- summary(fit)[[1]] %>%
    dplyr::mutate(strata = "All")}
  
  else{.strata <- names(summ)
  summ <- purrr::pmap(list(.strata, summ), function(.s, .summ){
    dplyr::mutate(.summ, strata = .s )})
  summ <- dplyr::bind_rows(summ)
  summ$strata <- factor(summ$strata, levels = .strata)}
  
  summ
  
}

# Check if all covariates are factor or character vector

.is_all_covariate_factor <- function(fit){
  x <- fit
mf <- stats::model.frame(x)
Xraw <- mf[,attr(mf, "covnames.orig"), drop=FALSE]
dat <- x$datasapply(Xraw,is_factor_or_character)}

is_factor_or_character <- function(x){is.facet(x) | is.character(x)}

#This code "saves" the modified code into the packageenvironment(ggflexsurvplotmod) <- asNamespace('survminer')
assignInNamespace("ggflexsurvplot", ggflexsurvplotmod, ns = "survminer")

然后，我运行以下命令

 code_example =  flexsurvreg(formula = Surv(time, status) ~ sex, data = lung,dist = "gompertz")

ggflexsurvplotmod(code_example, conf.int = T) `

这会导致以下错误

geom_ribbon（） 中的错误： 计算美学时的问题。 i 错误发生在第 5 层。 由错误引起： 未找到对象“surv”