|
1
|
|
#' Plot survival curves with number-at-risk table
|
|
2
|
|
#'
|
|
3
|
|
#' Produce a survival curve plot and number-at-risk table using \code{survminer::ggsurvplot}
|
|
4
|
|
#' and \code{finalfit} conventions.
|
|
5
|
|
#'
|
|
6
|
|
#' @param .data Dataframe.
|
|
7
|
|
#' @param dependent Character vector of length 1: Survival object of the form \code{Surv(time, status)}.
|
|
8
|
|
#' @param explanatory Character vector of max length 2: quoted name(s) of explanatory variables.
|
|
9
|
|
#' @param ... Arguments passed to \code{\link[survminer]{ggsurvplot}}.
|
|
10
|
|
#' @return Returns a table and plot produced in \code{ggplot2}.
|
|
11
|
|
#'
|
|
12
|
|
#' @family finalfit plot functions
|
|
13
|
|
#' @export
|
|
14
|
|
#' @import ggplot2
|
|
15
|
|
#'
|
|
16
|
|
#' @examples
|
|
17
|
|
#' library(finalfit)
|
|
18
|
|
#' library(dplyr)
|
|
19
|
|
#'
|
|
20
|
|
#' # Survival plot
|
|
21
|
|
#' data(colon_s)
|
|
22
|
|
#' explanatory = c("perfor.factor")
|
|
23
|
|
#' dependent = "Surv(time, status)"
|
|
24
|
|
#' colon_s %>%
|
|
25
|
|
#' surv_plot(dependent, explanatory, xlab="Time (days)", pval=TRUE, legend="none")
|
|
26
|
|
#'
|
|
27
|
|
surv_plot = function(.data, dependent, explanatory, ...){
|
|
28
|
1
|
if(length(explanatory)>2){
|
|
29
|
0
|
stop("Explanatory must have a maximum of two variables")
|
|
30
|
|
}
|
|
31
|
|
|
|
32
|
1
|
args = list(...)
|
|
33
|
1
|
.formula = as.formula(paste0(dependent, "~", paste(explanatory, collapse="+")))
|
|
34
|
1
|
args$fit = substitute(survival::survfit(.formula, data=.data), list(.formula=.formula))
|
|
35
|
1
|
args$data=.data
|
|
36
|
|
|
|
37
|
|
# Defaults which can be modified via ...
|
|
38
|
1
|
if (is.null(args$xlab)) args$xlab="Time"
|
|
39
|
1
|
if (is.null(args$ylab)) args$ylab="Probability"
|
|
40
|
1
|
if (is.null(args$censor)) args$censor=FALSE
|
|
41
|
1
|
if (is.null(args$conf.int)) args$conf.int=FALSE
|
|
42
|
1
|
if (is.null(args$risk.table)) args$risk.table=TRUE
|
|
43
|
1
|
if (is.null(args$linetype)) args$linetype="strata"
|
|
44
|
1
|
if (is.null(args$palette)) args$palette="lancet"
|
|
45
|
1
|
if (is.null(args$legend.title)) args$legend.title=""
|
|
46
|
1
|
if (is.null(args$font.x)) args$font.x=14
|
|
47
|
1
|
if (is.null(args$font.y)) args$font.y=14
|
|
48
|
1
|
if (is.null(args$font.tickslab)) args$font.tickslab=12
|
|
49
|
1
|
if (is.null(args$ggtheme)) args$ggtheme=theme_classic()
|
|
50
|
|
|
|
51
|
1
|
ggsurv = do.call(
|
|
52
|
1
|
survminer::ggsurvplot, args
|
|
53
|
|
)
|
|
54
|
1
|
ggsurv$table = ggsurv$table + survminer::theme_cleantable()
|
|
55
|
1
|
return(ggsurv)
|
|
56
|
|
}
|
|
57
|
|
|
|
58
|
|
|
|
59
|
|
# ggsurv <- ggsurvplot(fit3, data = colon,
|
|
60
|
|
# fun = "cumhaz", conf.int = TRUE,
|
|
61
|
|
# risk.table = TRUE, risk.table.col="strata",
|
|
62
|
|
# ggtheme = theme_bw())
|
|
63
|
|
# # Faceting survival curves
|
|
64
|
|
# curv_facet <- ggsurv$plot + facet_grid(rx ~ adhere)
|
|
65
|
|
# curv_facet
|
|
66
|
|
# # Faceting risk tables:
|
|
67
|
|
# # Generate risk table for each facet plot item
|
|
68
|
|
# ggsurv$table + facet_grid(rx ~ adhere, scales = "free")+
|
|
69
|
|
# theme(legend.position = "none")
|
|
70
|
|
# # Generate risk table for each facet columns
|
|
71
|
|
# tbl_facet <- ggsurv$table + facet_grid(.~ adhere, scales = "free")
|
|
72
|
|
# tbl_facet + theme(legend.position = "none")
|
|
73
|
|
# # Arrange faceted survival curves and risk tables
|
|
74
|
|
# g2 <- ggplotGrob(curv_facet)
|
|
75
|
|
# g3 <- ggplotGrob(tbl_facet)
|
|
76
|
|
# min_ncol <- min(ncol(g2), ncol(g3))
|
|
77
|
|
# g <- gridExtra::rbind.gtable(g2[, 1:min_ncol], g3[, 1:min_ncol], size="last")
|
|
78
|
|
# g$widths <- grid::unit.pmax(g2$widths, g3$widths)
|
|
79
|
|
# grid::grid.newpage()
|
|
80
|
|
# grid::grid.draw(g)
|
Nelson-Gon