How to use buttons in a Reactable widget for navigation in a Shiny application

Posted on by 24-7

[This article was first published on R | Discindo, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)

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.

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)))

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.

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)

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)

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).

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.

Leave a Reply

Your email address will not be published. Required fields are marked *