Create a ggplot2 survival curve with censored tabl

问题:

I am trying to create a Kaplan-Meier plot with 95% confidence bands plus having the censored data in a table beneath it. I can create the plot, but not the table. I get the error message: Error in grid.draw(both) : object 'both' not found.

   library(survival)
   library(ggplot2)
   library(GGally)
   library(gtable)
   data(lung) 
   sf.sex <- survfit(Surv(time, status) ~ sex, data = lung) 
   pl.sex <- ggsurv(sf.sex) +
   geom_ribbon(aes(ymin=low,ymax=up,fill=group),alpha=0.3) +
   guides(fill=guide_legend("sex"))
   pl.sex
   tbl <- ggplot(df_nums, aes(x = Time, y = factor(variable), colour =  variable,+
label=value)) +
   geom_text() +
   theme_bw() + 
   theme(panel.grid.major = element_blank(),+
   legend.position = "none",+
 plot.background = element_blank(), +
 panel.grid.major = element_blank(),+
 panel.grid.minor = element_blank(),+
      panel.border = element_blank(),+
      legend.position="none",+
      axis.line = element_blank(),+
      axis.text.x = element_blank(),+
      axis.text.y = element_text(size=15, face="bold", color = 'black'),+
      axis.ticks=element_blank(),+
      axis.title.x = element_blank(),+
      axis.title.y = element_blank(),+
      plot.title = element_blank()) + 
 scale_y_discrete(breaks=c("Group.A", "Group.B"), labels=c("Group A", "Group B"))
 both = rbind(ggplotGrob(g), ggplotGrob(tbl), size="last")
 panels <- both$layout$t[grep("panel", both$layout$name)]
 both$heights[panels] <- list(unit(1,"null"), unit(2, "lines"))
 both <- gtable_add_rows(both, heights = unit(1,"line"), 8)
 both <- gtable_add_grob(both, textGrob("Number at risk", hjust=0, x=0), t=9, l=2, r=4)
 grid.newpage()
 grid.draw(both)

回答1:

I solved the problem by using the Rcmdrplugin KMggplot2 The code is generated by the plugin after selecting the data and variables.

 library(survival, pos=18)
 data(lung, package="survival")
 lung <- within(lung, {
 sex <- factor(sex, labels=c('male','female'))
 })
 ggthemes_data <- ggthemes::ggthemes_data
 require("ggplot2")
 .df <- na.omit(data.frame(x = lung$time, y = lung$status, z = lung$sex))
 .df <- .df[do.call(order, .df[, c("z", "x"), drop = FALSE]), , drop = FALSE]
 .fit <- survival::survfit(survival::Surv(time = x, event = y, type = "right")      ~ z, 
   .df)
 .pval <- plyr::ddply(.df, plyr::.(),
  function(x) {
  data.frame(
  x = 0, y = 0, df = 1,
  chisq = survival::survdiff(
  survival::Surv(time = x, event = y, type = "right") ~ z, x
  )$chisq
 )})
 .pval$label <- paste0(
 "paste(italic(p), \" = ",
  signif(1 - pchisq(.pval$chisq, .pval$df), 3),
  "\")"
 )
 .fit <- data.frame(x = .fit$time, y = .fit$surv, nrisk = .fit$n.risk, nevent      = 
 .fit$n.event, ncensor= .fit$n.censor, upper = .fit$upper, lower = .fit$lower)
 .df <- .df[!duplicated(.df[,c("x", "z")]), ]
 .df <- .fit <- data.frame(.fit, .df[, c("z"), drop = FALSE])
 .med <- plyr::ddply(.fit, plyr::.(z), function(x) {
 data.frame(
 median = min(subset(x, y < (0.5 + .Machine$double.eps^0.5))$x)
 )})
 .df <- .fit <- rbind(unique(data.frame(x = 0, y = 1, nrisk = NA, nevent = NA, 
 ncensor = NA, upper = 1, lower = 1, .df[, c("z"), drop = FALSE])), .fit)
.cens <- subset(.fit, ncensor == 1)
.tmp1 <- data.frame(as.table(by(.df, .df[, c("z"), drop = FALSE], function(d) 
  max(d$nrisk, na.rm = TRUE))))
 .tmp1$x <- 0
 .nrisk <- .tmp1
 for (i in 1:9) {.df <- subset(.fit, x < 100 * i); .tmp2 <- 
 data.frame(as.table(by(.df, .df[, c("z"), drop = FALSE], function(d) if 
 (all(is.na(d$nrisk))) NA else min(d$nrisk - d$nevent - d$ncensor, na.rm =      TRUE)))); 
 .tmp2$x <- 100 * i; .tmp2$Freq[is.na(.tmp2$Freq)] <-     .tmp1$Freq[is.na(.tmp2$Freq)]; 
 .tmp1 <- .tmp2; .nrisk <- rbind(.nrisk, .tmp2)}
 .nrisk$y <- rep(seq(0.075, 0.025, -0.05), 10)
 .plot <- ggplot(data = .fit, aes(x = x, y = y, colour = z)) + 
  RcmdrPlugin.KMggplot2::geom_stepribbon(data = .fit, aes(x = x, ymin = lower,      ymax = 
  upper, fill = z), alpha = 0.25, colour = "transparent", show.legend = FALSE,     kmplot 
  = TRUE) + geom_step(size = 1.5) + 
geom_linerange(data = .cens, aes(x = x,     ymin = y, 
  ymax = y + 0.02), size = 1.5) + 
geom_text(data = .pval, aes(y = y, x = x,     label = 
  label), colour = "black", hjust = 0, vjust = -0.5, parse = TRUE, show.legend = 
  FALSE, size = 14 * 0.282, family = "sans") + 
  geom_vline(data = .med,      aes(xintercept 
 = median), colour = "black", lty = 2) + scale_x_continuous(breaks = seq(0,     900, by 
  = 100), limits = c(0, 900)) + 
 scale_y_continuous(limits = c(0, 1), expand =   c(0.01,0)) +      scale_colour_brewer(palette = "Set1") + scale_fill_brewer(palette =      "Set1") + 
    xlab("Time from entry") + ylab("Proportion of survival") + labs(colour =     "sex") + 
  ggthemes::theme_calc(base_size = 14, base_family = "sans") +             theme(legend.position 
  = c(1, 1), legend.justification = c(1, 1))
 .nrisk$y <- ((.nrisk$y - 0.025) / (max(.nrisk$y) - 0.025) + 0.5) * 0.5
 .plot2 <- ggplot(data = .nrisk, aes(x = x, y = y, label = Freq, colour = z)) + 
  geom_text(size = 14 * 0.282, family = "sans") + scale_x_continuous(breaks = seq(0,900, by = 100), limits = c(0, 900)) + 
  scale_y_continuous(limits = c(0, 1)) + 
  scale_colour_brewer(palette = "Set1") + ylab("Proportion of survival") + 
  RcmdrPlugin.KMggplot2::theme_natrisk(ggthemes::theme_calc, 14, "sans")
 .plot3 <- ggplot(data = subset(.nrisk, x == 0), aes(x = x, y = y, label = z, colour = z)) + 
  geom_text(hjust = 0, size = 14 * 0.282, family = "sans") + 
  scale_x_continuous(limits = c(-5, 5)) + scale_y_continuous(limits = c(0, 1)) + 
  scale_colour_brewer(palette = "Set1") + 
  RcmdrPlugin.KMggplot2::theme_natrisk21(ggthemes::theme_calc, 14, "sans")
 .plotb <- ggplot(.df, aes(x = x, y = y)) + geom_blank() + 
  RcmdrPlugin.KMggplot2::theme_natriskbg(ggthemes::theme_calc, 14, "sans")
  grid::grid.newpage(); grid::pushViewport(grid::viewport(layout = 
  grid::grid.layout(2, 2, heights = unit(c(1, 3), c("null", "lines")), widths  = 
  unit(c(4, 1), c("lines", "null"))))); 
  print(.plotb, vp = 
  grid::viewport(layout.pos.row = 1:2, layout.pos.col = 1:2)); 
  print(.plot , vp = 
  grid::viewport(layout.pos.row = 1  , layout.pos.col = 1:2)); 
  print(.plot2, vp = 
  grid::viewport(layout.pos.row = 2  , layout.pos.col = 1:2));
  print(.plot3, vp = 
  grid::viewport(layout.pos.row = 2  , layout.pos.col = 1  )); 
 .plot <-     recordPlot()
  print(.plot)

回答2:

Here's a start (code below)

I guess you can create the table need and replace it by the random.table

# install.packages("ggplot2", dependencies = TRUE)
# install.packages("RGraphics", dependencies = TRUE)
# install.packages("gridExtra", dependencies = TRUE)
# install.packages("survival", dependencies = TRUE)

require(ggplot2)
library(RGraphics)
library(gridExtra)
library(survival)

# Plot
   data(lung) 
   sf.sex <- survfit(Surv(time, status) ~ sex, data = lung) 
   pl.sex <- ggsurv(sf.sex) +
   geom_ribbon(aes(ymin=low,ymax=up,fill=group),alpha=0.3) +
   guides(fill=guide_legend("sex"))

# Table
random.table <- data.frame("CL 95"=rnorm(5),n=runif(5,1,3))
pl.table <- tableGrob(random.table)

# Arrange the plots on the same page
grid.arrange(pl.sex, pl.table, ncol=1)