[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.
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.
Related