Search code examples
rshinyreactable

Change dataframe in Shiny App based on Reactable checkboxes

This demo R script has two data frames, that are displayed by two Reactable tables. When the number of checkboxes in the Iris table exceeds 2, the warning message in the msg table should change.

Here is my non-working attempt

library("reactable")
library("shiny")
library("tidyverse")

max_num_boxes_checked <- 2

warn_last_update_df <- tibble(
  warn_msg = "Not too many selected",
  last_updated_msg = "Last updated: Sept 23, 2020"
)

ui <- fluidPage(
  reactableOutput("msg"),
  reactableOutput("table")
)

server <- function(input, output, session){
  output$msg <- renderReactable({
    reactable(warn_last_update_df,
              columns = list(
                "last_updated_msg" = colDef(
                  align = "right",
                  name = ""
                ),
                "warn_msg" = colDef(
                  name = ""
                )
              ))
 
  })
  output$table <- renderReactable({
    reactable(iris,
              onClick = "select",
              selection = "multiple")
  })  
  
  observeEvent(input$table,
    {
      state <- req(getReactableState("table"))

      # Get vector of which boxes are checked (their number)
      boxes_checked <- state[[4]]

      # Number of boxes checked
      num_boxes_checked <- (length(boxes_checked))

      # Change warning msg based on num checkboxes > 2
      if (num_boxes_checked > max_num_boxes_checked) {
        warn_last_update_df$warn_msg <- paste("Wow! More than ", max_num_boxes_checked, "checked")
        updateReactable("msg")
      }
    }
  )

}

shinyApp(ui, server)
Solution

  • It appears that updateReactable("msg") is not working. A workaround would be to use reactiveValues for the tibble warn_last_update_df. Here is a working code.

    max_num_boxes_checked <- 2

warn_last_update_df <- tibble(
  warn_msg = "Not too many selected",
  last_updated_msg = "Last updated: Sept 26, 2020"
)

ui <- fluidPage(
  reactableOutput("msg"),
  reactableOutput("table")
)

server <- function(input, output, session){
  selected <- reactiveValues(vec=NULL)
  DF1 <- reactiveValues(data=NULL)
  observe({
    selected$vec <- getReactableState("table", "selected")
    DF1$data <- warn_last_update_df
  })
  
  output$msg <- renderReactable({
    reactable(DF1$data, #warn_last_update_df,
              columns = list(
                "last_updated_msg" = colDef(
                  align = "right",
                  name = ""
                ),
                "warn_msg" = colDef(
                  name = ""
                )
              ))
    
  })
  output$table <- renderReactable({
    reactable(iris,
              onClick = "select",
              selection = "multiple")
  })
  
  observeEvent(selected$vec,{
    
    # Change warning msg based on num checkboxes > 2
    if (length(selected$vec) > max_num_boxes_checked) {
      #warn_last_update_df$warn_msg <- paste0("Wow! More than 2 rows checked")
      #updateReactable("msg",selected = NA)  ##  this is not working
      DF1$data[1,1] <- paste0("Wow! More than ", max_num_boxes_checked, " rows checked")
  
    }
    
  })
  
}

shinyApp(ui, server)

    output