While rendering DT table in shiny, is there a way to add pop up icon as shown below. So when user clicks on it, it should show some message :)
datatable(iris) #### while rendering DT table
While rendering DT table in shiny, is there a way to add pop up icon as shown below. So when user clicks on it, it should show some message :)
datatable(iris) #### while rendering DT table
Since you mention in your comment that you’d like the contents of the
message to also be clickable, you might be interested in Bootstrap
Popovers. The
shinyBS package provides some wrappers for them. However, I couldn’t get
it to work with a datatable header, so I made some custom helpers:
# Enable popovers -- needs to be included again with dynamic content
usePopover <- function() {
tags$script(HTML(
"$(function () {
$('[data-toggle=\"popover\"]').popover()
})"
))
}
popover <- function(tag, content = NULL, title = NULL, options = list()) {
if (!is.null(names(options))) {
names(options) <- paste0("data-", names(options))
}
tag |>
tagAppendAttributes(
`data-toggle` = "popover",
`data-content` = content,
title = title,
!!!options
)
}
You can use these in a datatable column header by defining a custom
columDefs element for the target column. While we’re there, we can also use
the same mechanism to inject the info icon, after making sure to include the
required dependency in the UI.
Avoiding the sorting behaviour when clicking on the icon in the header takes some extra work. Essentially, you have to make sure the click event doesn't bubble up to the event listeners in the datatable. For the icon, that can be done with JavaScript in a direct click handler on the element. For the popover itself, we can use a different container (body, in this case) so that it's no longer included inside the table in the DOM.
Here’s how this comes together:
library(shiny)
library(DT)
ui <- fluidPage(
# Need to add FontAwesome manually because no `icon()` calls in UI.
fontawesome::fa_html_dependency(),
DTOutput("table")
)
server <- function(input, output, session) {
output$table <- renderDT({
datatable(
data = iris,
options = list(
columnDefs = list(
list(
targets = 4,
title = paste(
"Petal.Width",
icon("info-circle") |>
popover(
tags$a(href = "https://stackoverflow.com", "Stack Overflow"),
# Prevent sorting when clicking on popover
options = list(html = TRUE, container = "body")
) |>
tagAppendAttributes(
# Prevent sorting when clicking on icon
onclick = "event.stopPropagation();"
) |>
tagList(usePopover())
)
)
)
)
)
})
}
shinyApp(ui, server)
And it ends up looking something like this:
You can set the column names like this:
library(shiny)
library(DT)
ui <- fluidPage(
DTOutput("table")
)
server <- function(input, output, session) {
output$table <- renderDataTable(escape = FALSE, {
colnames(iris) <- c("Sepal Length", "Sepal Width", "Petal Length",
"Petal Width <div title ='Hover tooltip'>info</div>", "Species")
iris
})
}
shinyApp(ui, server)
However, things like shiny::icon("info-circle") don't in the colnames.