/
add_risktable.R
169 lines (162 loc) · 6.25 KB
/
add_risktable.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
#' Add risk table
#'
#' Add risk tables below the plot showing the number at risk, events observed, and
#' number of censored observations.
#'
#' @param times numeric vector of times where risk table values will be placed.
#' Default are the times shown on the x-axis. The times passed here will not
#' modify the tick marks shown on the figure. To modify which tick marks are
#' shown, use `ggplot2::scale_x_continuous(breaks=)`.
#' @param risktable_stats character vector of statistics to show in the risk table.
#' Must be one or more of `c("n.risk", "cum.event", "cum.censor", "n.event", "n.censor")`.
#' Default is `c("n.risk", "cum.event")`.
#' - `"n.risk"` Number of patients at risk
#' - `"cum.event"` Cumulative number of observed events
#' - `"cum.censor"` Cumulative number of censored observations
#' - `"n.event"` Number of events in time interval
#' - `"n.censor"` Number of censored observations in time interval
#'
#' See additional details below.
#' @param stats_label named vector or list of custom labels. Names are the statistics
#' from `risktable_stats=` and the value is the custom label.
#' @param risktable_group String indicating the grouping variable for the risk tables.
#' Default is `"auto"` and will select `"strata"` or `"risktable_stats"` based on context.
#' - `"strata"` groups the risk tables per stratum when present.
#' - `"risktable_stats"` groups the risk tables per risktable_stats.
#' @param combine_groups logical indicating whether to combine the statistics
#' in the risk table across groups. Default is `FALSE`
#' @param risktable_height A numeric value between 0 and 1 indicates the proportion of the
#' final plot the risk table will occupy.
#' @param theme A risk table theme. Default is `theme_risktable_default()`
#' @param size,... arguments passed to `ggplot2::geom_text(...)`. Pass arguments like, `size = 4`
#' to increase the size of the statistics presented in the table.
#'
#' @section Customize Statistics:
#' You can customize how the statistics in the risk table are displayed by
#' utilizing [glue](https://glue.tidyverse.org/)-like syntax in the `risktable_stats`
#' argument.
#'
#' For example, if you prefer to have the number at risk and the number of events
#' on the same row, you can use `risktable_stats = "{n.risk} ({cum.event})"`.
#'
#' You can further customize the table to include the risk estimates using
#' elements `c("estimate", "conf.low", "conf.high", "std.error")`. When using
#' these elements, you'll likely need to include a function to round the estimates
#' and multiply them by 100.
#'
#' ```r
#' add_risktable(
#' risktable_stats =
#' c("{n.risk} ({cum.event})",
#' "{round(estimate*100)}% ({round(conf.low*100)}, {round(conf.high*100)})"),
#' stats_label = c("At Risk (Cum. Events)", "Survival (95% CI)")
#' )
#' ```
#'
#' @section Formatting Numbers:
#' You can also pass [glue](https://glue.tidyverse.org/)-like syntax to
#' `risktable_stats` to format the numbers displayed in
#' the risk table. This is particularly helpful when working with weighted
#' `survfit2` objects for which the risk table may display too many decimals by
#' default e.g., for weighted patients at risk.
#'
#' ```r
#' add_risktable(
#' risktable_stats = c("{format(round(n.risk, 2), nsmall = 2)}",
#' "{format(round(n.event, 2), nsmall = 2)}"),
#' stats_label = c("N effective patients at risk",
#' "N effective events")
#' )
#' ```
#'
#' @section Competing Risks:
#'
#' The `ggcuminc()` can plot multiple competing events.
#' The `"cum.event"` and `"n.event"` statistics are the sum of all events across
#' outcomes _shown on the plot_.
#'
#' @export
#' @return a ggplot2 figure
#' @examples
#' p <-
#' survfit2(Surv(time, status) ~ sex, data = df_lung) %>%
#' ggsurvfit() +
#' add_censor_mark() +
#' add_confidence_interval() +
#' scale_ggsurvfit()
#'
#' # using the function defaults
#' p + add_risktable()
#'
#' # change the statistics shown and the label
#' p +
#' add_risktable(
#' risktable_stats = "n.risk",
#' stats_label = list(n.risk = "Number at Risk"),
#' )
#'
#' p +
#' add_risktable(
#' risktable_stats = "{n.risk} ({cum.event})"
#' )
#'
#' p +
#' add_risktable(
#' risktable_stats = c("n.risk", "cum.event"),
#' combine_groups = TRUE
#' )
#' @inherit ggsurvfit seealso
add_risktable <- function(times = NULL,
risktable_stats = c("n.risk", "cum.event"),
risktable_group = c("auto", "strata", "risktable_stats"),
risktable_height = NULL,
stats_label = NULL,
combine_groups = FALSE,
theme = theme_risktable_default(),
size = 3.5,
...) {
add_risktable_empty_list <- list()
rlang::inject(
structure(add_risktable_empty_list,
"add_risktable" =
list(times = times,
risktable_stats = !!.convert_to_glue(risktable_stats),
stats_label = stats_label,
combine_groups = combine_groups,
risktable_group = match.arg(risktable_group),
risktable_height = risktable_height,
theme = theme,
!!!utils::modifyList(
x = list(size = size),
val = rlang::dots_list(...)
)
),
class = "add_risktable")
)
}
#' @export
ggplot_add.add_risktable <- function (object, plot, object_name) {
update_add_risktable(plot, object)
}
update_add_risktable <- function(p, add_risktable_empty_list) {
# confirm class and structure of object
.is_ggsurvfit(p, fun_name = "add_risktable()")
p +
ggplot2::theme(
plot.margin = ggplot2::unit(c(5.5, 5.5, 0, 5.5), "points"),
legend.margin = ggplot2::margin(t = 0, b = 0)
) +
rlang::inject(
structure(
ggplot2::geom_blank(),
add_risktable = !!attr(add_risktable_empty_list, "add_risktable")
)
)
}
.convert_to_glue <- function(x) {
possible_stats <-
c("n.risk", "n.event", "n.censor", "cum.event", "cum.censor",
"estimate", "conf.low", "conf.high", "std.error")
x[x %in% possible_stats] <- paste0("{", x[x %in% possible_stats], "}")
x
}