I have a reactable
with checkboxes in Shiny. For my reproducible example I took the iris dataset. On the table on the left side you can click on the checkboxes. On the right side it is shown simultaneously whether a checkbox is clicked. This works quite well so far (column select1
is set to TRUE). The problem is that after selecting another species as input and clicking on the update button, the content of right table is updated, but not the output-column of the checkboxes. The selected input of the checkboxes remains the same after the click on the update-button.
However, I would like to unbind all previous manual checkbox entries by clicking on the update button and set them back to the original value (=FALSE).
This picture shows the selection of the first 3 checkboxes, which is displayed as “TRUE” on the right table:
After selecting a new species
in the selectInput
and clicking the Update button, the right table is updated, but the “TRUE” values in column selected1
remain the same:
I have already asked the same question for DT::datatable
a few months ago:
R Shiny checkboxes do not update with observeEvent.
The solution for this datatable
-case was to define a javascript-function for unbinding all clickt checkboxInputs in the datatable-object:
tags$head(tags$script(
HTML(
"Shiny.addCustomMessageHandler('unbindDT', function(id) {
var $table = $('#'+id).find('table');
if($table.length > 0){
Shiny.unbindAll($table.DataTable().table().node());
}
})")
))
and then to apply this function inside the observeEvent
when updating the table:
observeEvent(input$update, {
session$sendCustomMessage("unbindDT", "table")
})
But now I want to implement the same use case for reactable
.
Does anyone have a solution to create a javascript function for my use case?
Here is my example app:
library(shiny)
library(shinyjs)
library(reactable)
library(tidyverse)
species <- c("setosa", "versicolor", "virginica")
shinyApp(
ui <- navbarPage(
title = div(HTML(
paste0("<br><b>", "My Shiny Web-App", "</b>")
)),
useShinyjs(),
tags$head(
tags$script(
"
$(document).on('shiny:value', function(e) {
if(e.name === 'table'){
setTimeout(function(){Shiny.bindAll(document.getElementById('table'))}, 0);
}});"
)
),
collapsible = TRUE,
tabPanel(title = h6(HTML("Tab1")),
fluidRow(
column(2,
sidebarPanel(
width = 12,
selectInput(
inputId = "myTextInput1",
label = h5("Select species"),
species
),
h5("Data"),
actionButton(
"update",
"Load / update data",
icon = icon("download"),
style = "color: #fff; background-color: #E74C3C"
)
)),
column(5,
mainPanel(width = 12,
fluidPage(
reactableOutput("table")
))),
column(5,
mainPanel(width = 12,
fluidPage(
tableOutput("table_download")
)))
))
),
server <- function(input, output, session) {
shinyInput <- function(FUN, len, id, ...) {
inputs <- character(len)
for (i in seq_len(len)) {
inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, ...))
}
inputs
}
shinyValue <- function(id, len) {
unlist(lapply(seq_len(len), function(i) {
value <- input[[paste0(id, i)]]
if (is.null(value))
FALSE
else
value
}))
}
rv1 <- reactiveValues(bad = NULL, good = NULL)
observeEvent(input$update, {
rv1$data_filter = iris %>% filter(Species == input$myTextInput1)
rv1$table = data.frame(rv1$data_filter,
select1 = shinyInput(checkboxInput, nrow(rv1$data_filter), 'select_1', value =
FALSE))
})
output$table <- renderReactable({
reactable(data = {
rv1$table
},
defaultColDef = colDef(html = TRUE))
})
table_download <- reactive({
data.frame(rv1$data_filter,
select1 = shinyValue('select_1', nrow(rv1$data_filter)))
})
output$table_download <- renderTable({
table_download()
})
}
)