-
Notifications
You must be signed in to change notification settings - Fork 23
/
add_sparkline.R
105 lines (101 loc) · 2.86 KB
/
add_sparkline.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
#' Add Sparkline Figure
#'
#' This function wraps `gtExtras::gt_plt_dist()` and adds a new column
#' illustrating the distribution of a continuous variable. This function converts
#' the gtsummary table into a gt table.
#'
#' @param x 'tbl_summary' object
#' @param type sparkline type. Must be one of `c("boxplot", "histogram", "rug_strip", "density", "sparkline")`
#' @param column_header string indicating column header
#' @inheritParams gtExtras::gt_plt_dist
#' @inheritDotParams gtExtras::gt_plt_dist -gt_object -column -same_limit -type
#'
#' @return a gt table
#' @family gtsummary-related functions
#' @export
#' @examples
#' library(gtsummary)
#'
#' add_sparkline_ex1 <-
#' trial %>%
#' select(age, marker) %>%
#' tbl_summary(missing = "no") %>%
#' add_sparkline()
#'
#' @section Example Output:
#' \if{html}{Example 1}
#'
#' \if{html}{\figure{add_sparkline_ex1.png}{options: width=50\%}}
add_sparkline <- function(x,
type = c("boxplot", "histogram", "rug_strip", "density", "sparkline"),
column_header = NULL,
same_limit = FALSE,
...) {
assert_package("gtExtras", "add_sparkline()")
if (!inherits(x, "tbl_summary")) {
stop("`x=` must be class 'tbl_summary'", call. = FALSE)
}
type <- match.arg(type)
include <-
broom.helpers::.select_to_varnames(
gtsummary::all_continuous(),
data = x$inputs$data,
var_info = x$table_body,
arg_name = "include"
)
column_header <-
column_header %||%
switch (
type,
"histogram" = "**Histogram**",
"density" = "**Density**",
"boxplot" = "**Box Plot**",
"rug_strip" = "**Rug Strip**",
"sparkline" = "**Sparkline**"
) %||%
"*Distribution**"
stopifnot(rlang::is_string(column_header))
if (!is.null(x$by)) {
message("Input table is stratified, but sparkline figure is not.")
}
if (type %in% "sparkline") {
gtExtras_gt_plt_fun <- gtExtras::gt_plt_sparkline
type <- "default"
}
else {
gtExtras_gt_plt_fun <- gtExtras::gt_plt_dist
}
tbl <-
x %>%
# merge in variables' distribution data
gtsummary::modify_table_body(
function(table_body) {
dplyr::left_join(
table_body,
tibble::tibble(
variable = include,
row_type = "label"
) %>%
mutate(
..sparkline_data.. =
map(
.data$variable,
~na.omit(x$inputs$data[[.x]])
)
),
by = c("variable", "row_type")
)
}
) %>%
# add a column header
gtsummary::modify_header(..sparkline_data.. = column_header) %>%
# convert to gt and add gtExtras sparkline
as_gt()
gtExtras_gt_plt_fun(
tbl,
column = "..sparkline_data..",
type = type,
same_limit = same_limit,
...
)
}