#' 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,
...
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.