How to update dataframe selection in real time using a shiny app?

I have the following app below, it takes a dataframe which is created in the shiny server, and uses this to generate tab Panels, which in turn checkboxes within each tab panel (3 checkboxes per tab panel) - within each tab panel there is a "select all" box which is supposed to essentially check all of the boxes in that tab panel

So what i need help with - is that i would like it so that if i am on tab 1 and "press" the "select all" button, then it will "check" all those boxes in that tab Panel (and of course "un-pressing" that button will deselect those boxes) - But i would also want the functionality, so that if you select a number of checkboxes in different tabs, then it would update accordingly and will not lose any information, (this includes pressing select all on different tabs also)

So for example i would want the following behaviour:

If you select the "Edibles" Tab > then press "select all" - all 3 checkboxes are selected

Now if you then select the "Fried" tab > then press "cheese" which is one of the options for the individual checkboxes - you will now have in total 4 checkboxes selected, all those from the "edibles" tab and just the one from the "fried" tab

So if we now de-select the "select all" button from the first tab "edibles", it loses all information and the checkbox in "Fried" which was "cheese" no longer is checked,

This is not the behaviour i would want - i would like it to update accordingly and have "cheese" still selected as we have unpressed select all

I have printed off the names of what is being selected where and when on the actual app

code is below:

Any thoughts?


header <- dashboardHeader(
  title = "My Dashboard",
  titleWidth = 500

siderbar <- dashboardSidebar(


    # Add buttons to choose the way you want to select your data
    radioButtons("select_by", "Select by:",
                 c("Food Type" = "Food",
                   "Gym Type" = "Gym",
                   "TV show" = "TV"))



body <- dashboardBody(


  tabBox(title = "RESULTS", width = 12, 
                  width = 12, 
                  height = 800


ui <- dashboardPage(header, siderbar, body, skin = "purple")

server <- function(input, output, session){

  nodes_data_1 <- data.frame(id = 1:15, 
                             Food = as.character(c("Edibles", "Fried", "Home Cooked", "packaged", "vending machine")), 
                             Product_name = as.character(c("Bacon", "Cheese", "eggs", "chips", "beans", "oast", "oats and beans", "fried beans", "chickpeas", "broad beans", "garbanzo", "oat bars", "dog meat", "cat food", "horse meat")),
                             Price = c(1:15), TV = 
                               sample(LETTERS[1:3], 15, replace = TRUE))

  # build a edges dataframe

  edges_data_1 <- data.frame(from = trunc(runif(15)*(15-1))+1,
                             to = trunc(runif(15)*(15-1))+1)

  # create reactive of nodes 

  nodes_data_reactive <- reactive({

  }) # end of reactive
  # create reacive of edges 

  edges_data_reactive <- reactive({


  }) # end of reactive"che

  # The output panel differs depending on the how the data is selected 
  # so it needs to be in the server section, not the UI section and created
  # with renderUI as it is reactive
  output$Output_panel <- renderUI({

    # When selecting by workstream and issues:
    if(input$select_by == "Food") {

      food <- unique(as.character(nodes_data_reactive()$Food))
      food_panel <- lapply(seq_along(food), function(i) {
        ### filter the data only once
        food_dt <- dplyr::filter(nodes_data_reactive(), Food == food[i])

        ### Use the id, not the price, as the id is unique
        food_ids <- as.character(food_dt$id)
        selected_ids <- food_ids[food_ids %in% isolate({chosen_food()})] ### use isolate, so as to not be reactive to it

                   paste0("checkboxfood_", i),
                   label = "Random Stuff",
                   choiceNames = as.character(food_dt$Product_name), ### for some reason it likes characters, not factors with extra levels
                   choiceValues = food_ids,
                   selected = selected_ids
                   paste0("all_", i),
                   "Select all",
                   value = all(food_ids %in% isolate({chosen_food()}))

      box(title = "Output PANEL", 
          collapsible = TRUE, 
          width = 12,

, c(id = 't', food_panel)),
          "Items: ", renderText(paste0(chosen_food(), collapse = ", ")),
          "Names: ", renderText(paste0(chosen_food_names(), collapse = ", ")) 

      ) # end of Tab box


  }) # end of renderUI

    lapply(1:length(unique(nodes_data_reactive()$Food)), function(i) {

      food <- unique(sort(as.character(nodes_data_reactive()$Food)))

      product_choices <- nodes_data_reactive() %>% 
        filter(Food == food[i]) %>%
        select(Product_name) %>%
        unlist(use.names = FALSE) %>%

      product_prices <- nodes_data_reactive() %>% 
        filter(Food == food[i]) %>%
        select(Price) %>%
        unlist(use.names = FALSE)

      if(!is.null(input[[paste0("all_", i)]])){
        if(input[[paste0("all_", i)]] == TRUE) {
                                   paste0("checkboxfood_", i), 
                                   label = NULL, 
                                   choiceNames = product_choices,
                                   choiceValues = product_prices,
                                   selected = product_prices)
        } else {
                                   paste0("checkboxfood_", i), 
                                   label = NULL, 
                                   choiceNames = product_choices,
                                   choiceValues = product_prices,
                                   selected = c()



  chosen_food <- reactive({
    unlist(lapply(seq_along(unique(nodes_data_reactive()$Food)), function(i) {
      # retrieve checkboxfood_NUMBER value
      input[[paste0("checkboxfood_", i)]]
  chosen_food_names <- reactive({
    # turn selected chosen food values into names

} # end of server

# Run the application 
shinyApp(ui = ui, server = server)

This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.