创建带截尾 table 的 ggplot2 生存曲线
Create a ggplot2 survival curve with censored table
我正在尝试创建一个具有 95% 置信区间的 Kaplan-Meier 图，并在其下方的 table 中放置删失数据。我可以创建情节，但不能创建 table。我收到错误消息： grid.draw(两者) 中的错误：找不到对象 'both'。
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)
这是一个开始（下面的代码）
我想您可以创建 table 需求并将其替换为 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)
我使用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)
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)
这是一个开始（下面的代码）
我想您可以创建 table 需求并将其替换为 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)
我使用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)