Skip to content

Instantly share code, notes, and snippets.

@gorgitko
Last active March 26, 2020 07:53
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save gorgitko/2ce01e37daa1edf68f2147f583fa2645 to your computer and use it in GitHub Desktop.
Save gorgitko/2ce01e37daa1edf68f2147f583fa2645 to your computer and use it in GitHub Desktop.
Simple function to add header tooltips to DT::datatable. Uses Bootstrap 3 tooltip component: https://getbootstrap.com/docs/3.3/javascript/#tooltips
# table_dt: DT::datatable
# tooltips: List of tooltips. Names = header names, values = tooltips.
# add_to_header_name: Will be appended to header name. Defaultly a question mark in circle.
# See https://getbootstrap.com/docs/3.3/components/ for more glyphicons
# tooltip_params: Parameters for Bootstrap's tooltip component.
# See https://getbootstrap.com/docs/3.4/javascript/#tooltips-options
# Will be converted to JSON with jsonlite::toJSON(tooltip_params, auto_unbox = TRUE)
# container = "body" is important as it always shows a tooltip on top of other elements.
dt_add_header_tooltips <- function(
table_dt,
tooltips,
add_to_header_name = "<span class='glyphicon glyphicon-question-sign' aria-hidden='true'></span>",
tooltip_params = list(
container = "body",
delay = list("show" = 0, "hide" = 50, placement = "auto")
)
) {
library(magrittr)
library(glue)
library(stringr)
dt_header_names <- colnames(table_dt$x$data)
tooltip_values <- tooltips %>%
str_trim() %>%
str_replace_all("\\n", " ") %>%
str_replace_all("\\s+", " ")
tooltip_df <- tibble::tibble(dt_header_name = dt_header_names) %>%
dplyr::left_join(
tibble::tibble(dt_header_name = names(tooltips), tooltip = unlist(tooltip_values)),
by = "dt_header_name") %>%
tidyr::replace_na(list(tooltip = ""))
tooltips_js_list <- glue("'{tooltip_df$tooltip}'") %>%
str_c(collapse = ", ")
header_callback <- glue(
"function(thead, data, start, end, display) {
var tooltips = [{{tooltips_js_list}}];
var tr = $(thead).find('th').each(function(i, el) {
var tooltip = tooltips[i];
if (tooltip != '') {
var el = $(el);
el.attr('data-toggle', 'tooltip');
el.attr('title', tooltips[i]);
}
});
$('th[data-toggle=\"tooltip\"]').tooltip({{jsonlite::toJSON(tooltip_params, auto_unbox = TRUE)}});
}",
.trim = FALSE, .open = "{{", .close = "}}"
) %>% as.character()
table_dt$x$options$headerCallback <- DT::JS(header_callback)
for (name in dt_header_names) {
if (!is.null(tooltips[[name]])) {
table_dt$x$container <- str_replace(
table_dt$x$container,
glue("(<th>)({name})(</th>)"),
glue("\\1\\2 {add_to_header_name}\\3")
)
}
}
return(table_dt)
}
tooltips <- list(
cyl = "Cylinders",
mpg = "Miles per Gallon",
am = "Transmission: 0 = Automatic, 1 = Manual"
)
table_dt <- DT::datatable(
mtcars,
filter = "top",
rownames = FALSE,
escape = FALSE,
class = "display compact",
# You can comment this to prevent styling of the table with Bootstrap.
style = "bootstrap"
)
# We need to add the bootstrap dependency.
# You can specify the name of theme, see ?rmarkdown::html_dependency_bootstrap
table_dt$dependencies <- c(
table_dt$dependencies,
list(rmarkdown::html_dependency_bootstrap("flatly"))
)
table_dt <- dt_add_header_tooltips(table_dt, tooltips)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment