Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
How to render and use buttons in tables is a relatively common task faced by {shiny}
developers. Commonly, buttons in tables are used for getting more details about a
row of data, for opening modal panels for user input, for displaying charts, and
of course, for navigation. There are many ways to achieve each of these tasks and
many tools to do it with. We can create an HTML table containing buttons
from scratch (e.g. here), or we can use table
widgets like the ones provided by the {reactable}
, {DT}
and many other packages.
In this post, we’ll introduce a very straightforward way to implement buttons and
use them for navigation (and alters) with the {reactable}
package. Most of what
you’ll see below is also documented in or derived from the reactable
docs.
Putting buttons in a {reactable}
To render buttons inside a reactable
widget
we need to make an HTML button tag for each row of the table, and add this column
of buttons as column in the data frame we wish to render. We also need to let reactable
know that the columns containing our buttons should be interpreted as HTML.
colA <- 1:3 colB <- c("A", "B", "C") makeButton <- function(label) { as.character(htmltools::tags$div(htmltools::tags$button(paste(label, "button")))) } colC <- as.character(lapply(c("A", "B", "C"), makeButton)) dataFrame <- data.frame(A = colA, B = colB, C = colC) reactable::reactable(dataFrame, columns = list(C = reactable::colDef(sortable = FALSE, html = TRUE)))
Making the buttons alive
For the buttons to respond to our clicks, we need to add an onclick
or ondbclick
event to each button. To do this, we add the onclick
argument to the tags$button
tag in our makeButton
function. Below, we create an event to each button that
will show the id of the button clicked:
labels <- LETTERS[1:3] buttonAlert <- function(label) { as.character(htmltools::tags$div(htmltools::tags$button( paste(label, "button"), onClick = sprintf("alert('Button value is: %s')", label) ))) } alertButtonsHTML <- as.character(lapply(labels, buttonAlert)) tableWithButtons <- reactable::reactable( data.frame( Names = labels, Alert = alertButtonsHTML ), columns = list( Alert = reactable::colDef(sortable = FALSE, html = TRUE) ) ) tableWithButtons
We also have the option to use reactable
’s onClick
argument,
however this requires writing a JavaScript function to figure our which row was
clicked and then trigger the appropriate action. In some complex scenarios,
such an approach might be necessary, but for this use case, its simple to attach
an onclick
event to each button when we create the HTML in R.
Using the buttons to toggle tabs
So far, we rendered a {reactable}
with buttons from R, and added events to the buttons
such that they trigger an alert in the browser showing the button id. This got us
part of the way towards our goal to use the button clicks for navigation in {shiny}
To be able to change tabs in a shiny application, we need to send the button id
from the browser to the server. We do this with the Shiny.setInputValue
JS function
as described in the shiny docs on JS to R communication.
Next, we’ll define two columns of buttons, one that trigger an alert like before,
and another that sets in input in {shiny}
’s session that can be accessed from the
server. To show this example we need a full {shiny}
application with a tabset panel
that we can toggle by clicking the {reactable}
buttons. Toggling between tabs
happens by the usual updateTabsetPanel
in an observer listening to the input
updated by the buttons.
tab_names <- LETTERS[1:3] buttonSetInput <- function(nav_id, nav_value) { as.character(htmltools::tags$div(htmltools::tags$button( paste("Go to tab", nav_value), onClick = sprintf( "Shiny.setInputValue('%s', '%s', {priority: 'event'})", nav_id, nav_value ) ))) } buttonWithAlert <- function(nav_id, nav_value) { as.character(htmltools::tags$div(htmltools::tags$button( paste("Alert", nav_value), onClick = sprintf("alert('Nav id is: %s, and nav value is: %s')", nav_id, nav_value) ))) } alertButtonsHTML <- as.character(lapply(tab_names, buttonWithAlert, nav_id = "myNav")) setInputButtonsHTML <- as.character(lapply(tab_names, buttonSetInput, nav_id = "myNav")) tableWithButtons <- reactable::reactable( data.frame( Names = LETTERS[1:3], Alert = alertButtonsHTML, SetInput = setInputButtonsHTML ), columns = list( Alert = reactable::colDef(sortable = FALSE,html = TRUE), SetInput = reactable::colDef(sortable = FALSE, html = TRUE) ) ) ui <- bslib::page_fluid( theme = bslib::bs_theme(version = 5, bootswatch = "flatly"), title = "Reactable buttons navigation", shiny::titlePanel("App navigation with buttons in reactable widget"), shiny::div( class = "row", shiny::div( class = "col-4", reactableOutput("myTab"), helpText("Input from reactable button is:"), verbatimTextOutput("inputFromTableButton"), bslib::navs_tab_card( id = "myTabs", bslib::nav(title = "Tab A", value = "A", "Contents of tab A"), bslib::nav(title = "Tab B", value = "B", "Contents of tab B"), bslib::nav(title = "Tab C", value = "C", "Contents of tab C") ) ) ) ) server <- function(input, output, session) { output$myTab <- renderReactable({ tableWithButtons }) output$inputFromTableButton <- renderPrint({ input$myNav }) shiny::observeEvent(input$myNav, { shiny::updateTabsetPanel(session = session, inputId = "myTabs", selected = input$myNav) }) } shiny::shinyApp(ui, server)
But this is not really navigation
Yes, so far we’ve only toggled tabs on the same page. For this to be ‘navigation’, when we click the buttons in the table we should ‘jump’ from one to another tab. The mechanism to do something like this is essentially the same, except we should render the table within one of our tabs, and then have buttons that lead to other tabs. The example app below is a minor tweak of what we saw earlier to achieve exactly that.
tab_names <- LETTERS[1:3] buttonSetInput <- function(nav_id, nav_value) { as.character(htmltools::tags$div(htmltools::tags$button( paste("Go to tab", nav_value), onClick = sprintf( "Shiny.setInputValue('%s', '%s', {priority: 'event'})", nav_id, nav_value ) ))) } buttonWithAlert <- function(nav_id, nav_value) { as.character(htmltools::tags$div(htmltools::tags$button( paste("Alert", nav_value), onClick = sprintf("alert('Nav id is: %s, and nav value is: %s')", nav_id, nav_value) ))) } alertButtonsHTML <- as.character(lapply(tab_names, buttonWithAlert, nav_id = "myNav")) setInputButtonsHTML <- as.character(lapply(tab_names, buttonSetInput, nav_id = "myNav")) tableWithButtons <- reactable::reactable( data.frame( Names = LETTERS[1:3], Alert = alertButtonsHTML, SetInput = setInputButtonsHTML ), columns = list( Alert = reactable::colDef(sortable = FALSE,html = TRUE), SetInput = reactable::colDef(sortable = FALSE, html = TRUE) ) ) ui <- bslib::page_fluid( theme = bslib::bs_theme(version = 5, bootswatch = "flatly"), title = "Reactable buttons navigation", shiny::titlePanel("App navigation with buttons in reactable widget"), shiny::div( class = "row", shiny::div( class = "col-4", helpText("Input from reactable button is:"), verbatimTextOutput("inputFromTableButton"), bslib::navs_tab_card( id = "myTabs", bslib::nav(title = "Tab X", value = "X", reactableOutput("myTab")), bslib::nav(title = "Tab A", value = "A", "Contents of tab A"), bslib::nav(title = "Tab B", value = "B", "Contents of tab B"), bslib::nav(title = "Tab C", value = "C", "Contents of tab C") ) ) ) ) server <- function(input, output, session) { output$myTab <- renderReactable({ tableWithButtons }) output$inputFromTableButton <- renderPrint({ input$myNav }) shiny::observeEvent(input$myNav, { shiny::updateTabsetPanel(session = session, inputId = "myTabs", selected = input$myNav) }) } shiny::shinyApp(ui, server)
What if we used modules?
In a realistic app, we would probably use shiny modules.
We could easily construct a scenario where the reactable
is rendered through a
module, or where each tab is a separate module. The pattern we described above
works in this case too, except, with modules, we have keep track of the namespaces.
Modules are isolated, so an input value updated in module X will not be known to
module Y. We have to implement some way of communication between modules.
Below is one of several ways to send a message from one module to another. In this, case we pass a value from a ‘submodule’ to the calling module. This is a common case, for example, we have the main app server with top-level navigation, that is calling modules for ‘pages’ within the application. The key is to return the input updated by the submodule as a reactive that can be observed in the top-level module.
tab_names <- LETTERS[1:3] buttonSetInput <- function(nav_id, nav_value) { as.character(htmltools::tags$div(htmltools::tags$button( paste("Go to tab", nav_value), onClick = sprintf( "Shiny.setInputValue('%s', '%s', {priority: 'event'})", nav_id, nav_value ) ))) } buttonWithAlert <- function(nav_id, nav_value) { as.character(htmltools::tags$div(htmltools::tags$button( paste("Alert", nav_value), onClick = sprintf("alert('Nav id is: %s, and nav value is: %s')", nav_id, nav_value) ))) } rTabUI <- function(id) { ns <- NS(id) tagList( reactableOutput(ns("myTab")) ) } rTabServer <- function(id) { moduleServer( id, function(input, output, session) { ns <- session$ns alertButtonsHTML <- as.character(lapply(tab_names, buttonWithAlert, nav_id = ns("myNav"))) setInputButtonsHTML <- as.character(lapply(tab_names, buttonSetInput, nav_id = ns("myNav"))) tableWithButtons <- reactable::reactable( data.frame( Names = LETTERS[1:3], Alert = alertButtonsHTML, SetInput = setInputButtonsHTML ), columns = list( Alert = reactable::colDef(sortable = FALSE,html = TRUE), SetInput = reactable::colDef(sortable = FALSE, html = TRUE) ) ) output$myTab <- renderReactable({ tableWithButtons }) return(list( getButtonValue = shiny::reactive(input$myNav) )) } ) } ui <- bslib::page_fluid( theme = bslib::bs_theme(version = 5, bootswatch = "flatly"), title = "Reactable buttons navigation", shiny::titlePanel("App navigation with buttons in reactable widget"), shiny::div( class = "row", shiny::div( class = "col-4", helpText("Input from reactable button is:"), verbatimTextOutput("inputFromTableButton"), bslib::navs_tab_card( id = "myTabs", bslib::nav(title = "Tab X", value = "X", rTabUI("rtab") ), bslib::nav(title = "Tab A", value = "A", "Contents of tab A"), bslib::nav(title = "Tab B", value = "B", "Contents of tab B"), bslib::nav(title = "Tab C", value = "C", "Contents of tab C") ) ) ) ) server <- function(input, output, session) { rTabOut <- rTabServer("rtab") output$inputFromTableButton <- renderPrint({ rTabOut$getButtonValue() }) shiny::observeEvent(rTabOut$getButtonValue(), { shiny::updateTabsetPanel(session = session, inputId = "myTabs", selected = rTabOut$getButtonValue()) }) } shiny::shinyApp(ui, server)
Other ways to implement communication between modules include passing (reactive)
values through session$userData
(e.g. here)
or updating values in an environment or R6
class passed to each module as an
argument (e.g. here).
Summary
In this post we covered some examples of how one could implement navigation between
‘pages’ in a {shiny}
application using buttons in a reactable
. We saw how to
generate some buttons, how to update input values on button click, how to listen
to changes from the buttons, and how to pass the user selections between modules.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.