A modified ggsurvplot

myggsurvplot <- function (fit, data = NULL, fun = NULL, color = NULL, palette = NULL,
    linetype = 1, break.x.by = NULL, break.y.by = NULL, break.time.by = NULL,
    surv.scale = c("default", "percent"), conf.int = FALSE, conf.int.fill = "gray",
    conf.int.style = "ribbon", censor = TRUE, pval = FALSE, pval.size = 5,
    pval.coord = c(NULL, NULL), pval.method = FALSE, pval.method.size = pval.size,
    pval.method.coord = c(NULL, NULL), log.rank.weights = c("survdiff",
        "1", "n", "sqrtN", "S1", "S2", "FH_p=1_q=1"), title = NULL,
    xlab = "Time", ylab = "Survival probability", xlim = NULL,
    ylim = NULL, legend = c("top", "bottom", "left", "right",
        "none"), legend.title = "Strata", legend.labs = NULL,
    tables.height = 0.25, tables.y.text = TRUE, tables.col = "black",
    risk.table = FALSE, risk.table.pos = c("out", "in"), risk.table.title = NULL,
    risk.table.col = tables.col, risk.table.fontsize = 4.5, fontsize = 4.5,
    risk.table.y.text = tables.y.text, risk.table.y.text.col = TRUE,
    risk.table.height = tables.height, surv.plot.height = 0.75,
    ncensor.plot.height = tables.height, cumevents.height = tables.height,
    cumcensor.height = tables.height, ncensor.plot = FALSE, ncensor.plot.title = NULL,
    cumevents = FALSE, cumevents.col = tables.col, cumevents.title = NULL,
    cumevents.y.text = tables.y.text, cumevents.y.text.col = TRUE,
    cumcensor = FALSE, cumcensor.col = tables.col, cumcensor.title = NULL,
    cumcensor.y.text = tables.y.text, cumcensor.y.text.col = TRUE,
    surv.median.line = c("none", "hv", "h", "v"), ggtheme = theme_survminer(),
    tables.theme = ggtheme, ...)
{
    if (!inherits(fit, "survfit"))
        stop("Can't handle an object of class ", class(fit))
    size <- ifelse(is.null(list(...)$size), 1, list(...)$size)
    if (is.null(xlim))
        xlim <- c(0, max(fit$time))
    if (is.null(ylim) & is.null(fun))
        ylim <- c(0, 1)
    if (!is(legend, "numeric"))
        legend <- match.arg(legend)
    surv.median.line <- match.arg(surv.median.line)
    stopifnot(log.rank.weights %in% c("survdiff", "1", "n", "sqrtN",
        "S1", "S2", "FH_p=1_q=1"))
    log.rank.weights <- match.arg(log.rank.weights)
    if (ncensor.plot & cumcensor) {
        warning("Both ncensor.plot and cumsensor are TRUE.",
            "In this case, we consider only cumcensor.", call. = FALSE)
        ncensor.plot <- FALSE
    }
    if (cumcensor)
        ncensor.plot.height <- cumcensor.height
    if (is.null(ncensor.plot.title))
        ncensor.plot.title <- "Number of censoring"
    if (is.null(cumcensor.title))
        cumcensor.title <- "Cumulative number of censoring"
    if (is.null(cumevents.title))
        cumevents.title <- "Cumulative number of events"
    ylab <- survminer:::.check_ylab(ylab, fun)
    lty <- survminer:::.get_lty(linetype)
    linetype <- lty$lty
    linetype.manual <- lty$lty.manual
    survminer:::.check_legend_labs(fit, legend.labs)
    risk.table.pos <- match.arg(risk.table.pos)
    risktable <- survminer:::.parse_risk_table_arg(risk.table)
    risk.table <- risktable$display
    risk.table.type <- risktable$type
    extra.params <- list(...)
    data <- survminer:::.get_data(fit, data = data)
    d <- surv_summary(fit, data = data)
    .strata <- d$strata
    if (!is.null(.strata)) {
        strata_names <- levels(.strata)
        n.strata <- length(strata_names)
        if (is.null(legend.labs))
            legend.labs <- strata_names
        if (missing(color))
            color <- "strata"
    }
    else {
        n.strata <- 1
        if (is.null(legend.labs)) {
            .strata <- as.factor(rep("All", nrow(d)))
            legend.labs <- strata_names <- "All"
        }
        else {
            .strata <- as.factor(rep(legend.labs, nrow(d)))
            strata_names <- legend.labs
        }
        if (missing(conf.int))
            conf.int = TRUE
        if (missing(color))
            color <- "black"
    }
    d$strata <- .strata
    d <- survminer:::.connect2origin(d, fit, data)
    d <- survminer:::.apply_surv_func(d, fun = fun)
    surv.scale <- match.arg(surv.scale)
    scale_labels <- ggplot2::waiver()
    if (surv.scale == "percent")
        scale_labels <- scales::percent
    y.breaks <- ggplot2::waiver()
    if (!is.null(break.y.by))
        y.breaks <- seq(0, 1, by = break.y.by)
    d$strata <- factor(d$strata, levels = strata_names, labels = legend.labs)
    d <- d[order(d$strata), , drop = FALSE]
    surv.color <- ifelse(n.strata > 1, "strata", color)
    p <- ggplot2::ggplot(d, ggplot2::aes_string("time", "surv")) +
        ggpubr::geom_exec(ggplot2::geom_step, data = d, size = size,
            color = surv.color, linetype = linetype, ...) + ggplot2::scale_y_continuous(breaks = y.breaks,
        labels = scale_labels, limits = ylim, expand = c(0, 0)) + ggplot2::coord_cartesian(xlim = xlim) +
        ggtheme
    p <- ggpubr::ggpar(p, palette = palette, ...)
    if (!is.null(break.x.by))
        break.time.by <- break.x.by
    if (is.null(break.time.by))
        times <- survminer:::.get_default_breaks(fit$time)
    else times <- seq(0, max(c(fit$time, xlim)), by = break.time.by)
    p <- p + ggplot2::scale_x_continuous(breaks = times, expand = c(0, 0))
    if (conf.int) {
        if (missing(conf.int.fill))
            conf.int.fill <- surv.color
        if (conf.int.style == "ribbon") {
            p <- p + ggpubr::geom_exec(.geom_confint, data = d,
                ymin = "lower", ymax = "upper", fill = conf.int.fill,
                alpha = 0.3, na.rm = TRUE)
        }
        else if (conf.int.style == "step") {
            p <- p + ggpubr::geom_exec(ggplot2::geom_step, data = d,
                y = "lower", linetype = "dashed", color = surv.color,
                na.rm = TRUE) + ggpubr::geom_exec(ggplot2::geom_step,
                data = d, y = "upper", linetype = "dashed", color = surv.color,
                na.rm = TRUE)
        }
    }
    if (censor & any(d$n.censor >= 1)) {
        p <- p + ggpubr::geom_exec(ggplot2::geom_point, data = d[d$n.censor >
            0, , drop = FALSE], colour = surv.color, size = size *
            4.5, shape = "+")
    }
    if (pval & !is.null(fit$strata)) {
        pval <- survminer:::.get_pvalue(fit, method = log.rank.weights, data = data)
        pvaltxt <- ifelse(pval$val < 1e-04, "p < 0.0001", paste("p =",
            signif(pval$val, 2)))
        pval.x <- ifelse(is.null(pval.coord[1]), max(fit$time)/50,
            pval.coord[1])
        pval.y <- ifelse(is.null(pval.coord[2]), 0.2, pval.coord[2])
        p <- p + ggplot2::annotate("text", x = pval.x, y = pval.y,
            label = pvaltxt, size = pval.size, hjust = 0)
        if (pval.method) {
            pvalmethod <- pval$method
            pval.method.x <- ifelse(is.null(pval.method.coord[1]),
                max(fit$time)/50, pval.method.coord[1])
            pval.method.y <- ifelse(is.null(pval.method.coord[2]),
                0.3, pval.method.coord[2])
            p <- p + ggplot2::annotate("text", x = pval.method.x,
                y = pval.method.y, label = pvalmethod, size = pval.method.size,
                hjust = 0)
        }
    }
    if (surv.median.line %in% c("hv", "h", "v"))
        p <- .add_surv_median(p, fit, type = surv.median.line,
            fun = fun, data = data)
    p <- p + ggplot2::expand_limits(x = 0, y = 0)
    lty.leg.title <- ifelse(linetype == "strata", legend.title,
        linetype)
    p <- p + ggplot2::labs(x = xlab, y = ylab, title = title,
        color = legend.title, fill = legend.title, linetype = lty.leg.title)
    p <- survminer:::.set_general_gpar(p, legend = legend, ...)
    if (!is.null(linetype.manual))
        p <- p + scale_linetype_manual(values = linetype.manual)
    res <- list(plot = p)
    g <- ggplot_build(p)
    scurve_cols <- unlist(unique(g$data[[1]]["colour"]))
    if (length(scurve_cols) == 1)
        scurve_cols <- rep(scurve_cols, length(legend.labs))
    names(scurve_cols) <- legend.labs
    if (risk.table) {
        if (risk.table.pos == "in")
            risk.table.col = surv.color
        risktable <- myggrisktable(fit, data = data, type = risk.table.type,
            color = risk.table.col, palette = palette, break.time.by = break.time.by,
            xlim = xlim, title = risk.table.title, legend = legend,
            legend.title = legend.title, legend.labs = legend.labs,
            y.text = risk.table.y.text, y.text.col = risk.table.y.text.col,
            fontsize = risk.table.fontsize, ggtheme = ggtheme,
            xlab = xlab, ylab = legend.title, ...)
        risktable <- risktable + tables.theme
        if (!risk.table.y.text)
            risktable <- survminer:::.set_large_dash_as_ytext(risktable)
        if (risk.table.y.text.col)
            risktable <- risktable + theme(axis.text.y = element_text(colour = rev(scurve_cols)))
        res$table <- risktable
    }
    if (cumevents) {
        res$cumevents <- ggcumevents(fit, data = data, color = cumevents.col,
            palette = palette, break.time.by = break.time.by,
            xlim = xlim, title = cumevents.title, legend = legend,
            legend.title = legend.title, legend.labs = legend.labs,
            y.text = cumevents.y.text, y.text.col = cumevents.y.text.col,
            fontsize = fontsize, ggtheme = ggtheme, xlab = xlab,
            ylab = legend.title, ...)
        res$cumevents <- res$cumevents + tables.theme
        if (!cumevents.y.text)
            res$cumevents <- survminer:::.set_large_dash_as_ytext(res$cumevents)
        if (cumevents.y.text.col)
            res$cumevents <- res$cumevents + theme(axis.text.y = element_text(colour = rev(scurve_cols)))
    }
    if (ncensor.plot) {
        ncensor_plot <- ggplot(d, aes_string("time", "n.censor")) +
            ggpubr::geom_exec(geom_bar, d, color = surv.color,
                fill = surv.color, stat = "identity", position = "dodge") +
             scale_x_continuous(breaks = times,expand = c(0, 0)) +
            scale_y_continuous(breaks = sort(unique(d$n.censor)),expand = c(0, 0)) +
            ggtheme
        ncensor_plot <- ggpubr::ggpar(ncensor_plot, palette = palette)
        ncensor_plot <- ncensor_plot + ggplot2::labs(color = legend.title,
            fill = legend.title, x = xlab, y = "n.censor", title = ncensor.plot.title)
        ncensor_plot <- survminer:::.set_general_gpar(ncensor_plot, ...)
        ncensor_plot <- survminer:::.set_ncensorplot_gpar(ncensor_plot, ...)
        ncensor_plot <- ncensor_plot + tables.theme
    }
    else if (cumcensor) {
        ncensor_plot <- ggcumcensor(fit, data = data, color = cumcensor.col,
            palette = palette, break.time.by = break.time.by,
            xlim = xlim, title = cumcensor.title, legend = legend,
            legend.title = legend.title, legend.labs = legend.labs,
            y.text = cumcensor.y.text, y.text.col = cumcensor.y.text.col,
            fontsize = fontsize, ggtheme = ggtheme, xlab = xlab,
            ylab = legend.title, ...)
        ncensor_plot <- ncensor_plot + tables.theme
        if (!cumcensor.y.text)
            ncensor_plot <- survminer:::.set_large_dash_as_ytext(ncensor_plot)
        if (cumcensor.y.text.col)
            ncensor_plot <- ncensor_plot + theme(axis.text.y = element_text(colour = rev(scurve_cols)))
    }
    if (ncensor.plot | cumcensor)
        res$ncensor.plot <- ncensor_plot
    heights <- list(plot = surv.plot.height, table = ifelse(risk.table,
        risk.table.height, 0), ncensor.plot = ifelse(ncensor.plot |
        cumcensor, ncensor.plot.height, 0), cumevents = ifelse(cumevents,
        cumevents.height, 0))
    y.text <- list(table = risk.table.y.text, cumevents = cumevents.y.text,
        cumcensor = cumcensor.y.text)
    y.text.col <- list(table = risk.table.y.text.col, cumevents = cumevents.y.text.col,
        cumcensor = cumcensor.y.text.col)
    res$data.survplot <- d
    res$data.survtable <- survminer:::.get_timepoints_survsummary(fit, data,
        times)
    class(res) <- c("ggsurvplot", "ggsurv", "list")
    attr(res, "heights") <- heights
    attr(res, "y.text") <- y.text
    attr(res, "y.text.col") <- y.text.col
    attr(res, "legend.position") <- legend
    attr(res, "legend.labs") <- legend.labs
    attr(res, "cumcensor") <- cumcensor
    attr(res, "risk.table.pos") <- risk.table.pos
    res
}


myggrisktable <- function (fit, data = NULL, type = c("absolute", "percentage",
    "abs_pct", "nrisk_cumcensor", "nrisk_cumevents"), color = "black",
    palette = NULL, break.time.by = NULL, xlim = NULL, title = NULL,
    xlab = "Time", ylab = "Strata", legend = "top", legend.title = "Strata",
    legend.labs = NULL, y.text = TRUE, y.text.col = TRUE, fontsize = 4.5,
    ggtheme = theme_light(), ...)
{
    if (!inherits(fit, "survfit"))
        stop("Can't handle an object of class ", class(fit))
    if (is.null(xlim))
        xlim <- c(0, max(fit$time))
    survminer:::.check_legend_labs(fit, legend.labs)
    type <- match.arg(type)
    if (is.null(title)) {
        title <- switch(type, absolute = "Number at risk", percentage = "Percentage at risk",
            abs_pct = "Number at risk: n (%)", nrisk_cumcensor = "Number at risk (number censored)",
            nrisk_cumevents = "Number at risk (number of events)",
            "Number at risk")
    }
    data <- survminer:::.get_data(fit, data = data)
    if (is.null(break.time.by))
        times <- survminer:::.get_default_breaks(fit$time)
    else times <- seq(0, max(c(fit$time, xlim)), by = break.time.by)
    survsummary <- survminer:::.get_timepoints_survsummary(fit, data, times)
    if (!is.null(legend.labs))
        survsummary$strata <- factor(survsummary$strata, labels = legend.labs)
    if (is.null(legend.labs))
        legend.labs <- levels(survsummary$strata)
    yticklabs <- rev(levels(survsummary$strata))
    n_strata <- length(levels(survsummary$strata))
    if (!y.text)
        yticklabs <- rep("-", n_strata)
    time <- strata <- label <- pct.risk <- abs_pct.risk <- n.risk <- NULL
    llabels <- switch(type, percentage = round(survsummary$n.risk *
        100/survsummary$strata_size), abs_pct = paste0(survsummary$n.risk,
        " (", survsummary$pct.risk, ")"), nrisk_cumcensor = paste0(survsummary$n.risk,
        " (", survsummary$cum.n.censor, ")"), nrisk_cumevents = paste0(survsummary$n.risk,
        " (", survsummary$cum.n.event, ")"), survsummary$n.risk)
    survsummary$llabels <- llabels
    p <- ggplot(data = survsummary, aes(x = time, y = rev(strata),
        label = llabels, shape = rev(strata)))
    p <- p + ggpubr::geom_exec(geom_text, data = survsummary,
        size = fontsize, color = color) + scale_shape_manual(values = 1:length(levels(survsummary$strata))) +
        ggtheme + scale_y_discrete(breaks = as.character(levels(survsummary$strata)),
        labels = yticklabs) + coord_cartesian(xlim = xlim) +
        scale_x_continuous(breaks = times, expand = c(0, 0)) + labs(title = title,
        x = xlab, y = ylab, color = legend.title, shape = legend.title)
    p <- survminer:::.set_risktable_gpar(p, ...)
    p <- ggpubr::ggpar(p, legend = legend, palette = palette,
        ...)
    if (!y.text)
        p <- .set_large_dash_as_ytext(p)
    if (y.text.col) {
        g <- ggplot2::ggplot_build(p)
        cols <- unlist(unique(g$data[[1]]["colour"]))
        if (length(cols) == 1)
            cols <- rep(cols, length(legend.labs))
        names(cols) <- legend.labs
        p <- p + theme(axis.text.y = element_text(colour = rev(cols)))
    }
    p
}