使用刪減表創建ggplot2生存曲線

Question

我正在嘗試創建一個帶95％置信度的Kaplan-Meier圖，並在其下的表中添加了刪除數據。我可以創造情節，但不是桌子。我得到錯誤消息：錯誤在grid.draw（都）：對象'兩'未找到。

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) 

Answer 1

取代它，我用的問題解決了Rcmdrplugin KMggplot2代碼在選擇數據和變量後由插件生成。

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) 

Answer 2

這裏是一個開始（下面的代碼）

我想你可以創建表需要，由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)