Argthtjtr

I have the following shiny dashboard app, this app currently generates checkboxes from a dataframe which i have created in the server section - there is also a select all button, what i want to do is the following:

1) create a reactive - (there is an example of a commented section in the code where i have attempted this, but it did not work) - this reactive should contain the "id" values of the selected checkbox (so this the values in the first column of the underlying data frame)

2) Make sure that this works for these scenarios - when a user selects checkboxes on their own, and then it also works when a user presses the "select all" button - so this reactive will update and populate itself in either of those situations

I have commented out some code where i attempted this but ran into errors and issues - does anyone know how to actually get those id values for what you select in the checkboxes? this has to work across all tabs and also work if the select all button is pressed or un pressed

code for reference!

library(shiny)

library(shinydashboard) 

library(tidyverse)

library(magrittr)



header <- dashboardHeader(

  title = "My Dashboard",

  titleWidth = 500

)



siderbar <- dashboardSidebar(



  sidebarMenu(



    # Add buttons to choose the way you want to select your data

    radioButtons("select_by", "Select by:",

                 c("Work Pattern" = "Workstream"))



  )   



)



body <- dashboardBody(



  fluidRow(

    uiOutput("Output_panel")



  ), 

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

         tabPanel("Visualisation", 

                  width = 12, 

                  height = 800

         )





  )

) 



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





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



  nodes_data_1 <- data.frame(id = 1:15, 

                             Workstream = as.character(c("Finance", "Energy", "Transport", "Health", "Sport")), 

                             Product_name = as.character(c("Actuary", "Stock Broker", "Accountant", "Nuclear Worker", "Hydro Power", "Solar Energy", "Driver", "Aeroplane Pilot", "Sailor", "Doctor", "Nurse", "Dentist", "Football", "Basketball","Cricket")),

                             Salary = c(1:15))



  # 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({

    nodes_data_1





  }) # end of reactive

  # create reacive of edges 



  edges_data_reactive <- reactive({



    edges_data_1



  }) # 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 == "Workstream") {



      box(title = "Output PANEL", 

          collapsible = TRUE, 

          width = 12,



          do.call(tabsetPanel, c(id='t',lapply(1:length(unique(nodes_data_reactive()$Workstream)), function(i) {

            testing <- unique(sort(as.character(nodes_data_reactive()$Workstream)))



            tabPanel(testing[i], 

                     checkboxGroupInput(paste0("checkbox_", i), 

                                        label = "Random Stuff",

                                        choiceNames = unique(nodes_data_reactive()$Product_name[

                                          nodes_data_reactive()$Workstream == unique(nodes_data_reactive()$testing)[i]]), choiceValues = unique(nodes_data_reactive()$Salary[

                                            nodes_data_reactive()$Workstream == unique(nodes_data_reactive()$testing)[i]])











                     ),

                     checkboxInput(paste0("all_", i), "Select all", value = FALSE)

            )

          })))



      ) # end of Tab box







    }  # end  if



  }) # end of renderUI



  observe({

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



      testing <- unique(sort(as.character(nodes_data_reactive()$Workstream)))



      product_choices <- nodes_data_reactive() %>% 

        filter(Workstream == testing[i]) %>%

        select(Product_name) %>%

        unlist(use.names = FALSE) %>%

        as.character()



      product_prices <- nodes_data_reactive() %>% 

        filter(Workstream == testing[i]) %>%

        select(Salary) %>%

        unlist(use.names = FALSE)



      if(!is.null(input[[paste0("all_", i)]])){

        if(input[[paste0("all_", i)]] == TRUE) {

          updateCheckboxGroupInput(session,

                                   paste0("checkbox_", i), 

                                   label = NULL, 

                                   choiceNames = product_choices,

                                   choiceValues = product_prices,

                                   selected = product_prices)

        } else {

          updateCheckboxGroupInput(session,

                                   paste0("checkbox_", i), 

                                   label = NULL, 

                                   choiceNames = product_choices,

                                   choiceValues = product_prices,

                                   selected = c()

          )

        }

      }



    })

  })











  # this code here is what i want to adapt or change 



  # What i want is to create two things 

  # one is a reactive that will update when a user selects checkboxes (but not the all checkbox) 

  # this will then result in the unique id values from the id column to appear 

  # i would also want this reactive to work in conjuction with the select all button 

  # so that if a user hits the button - then this reactive will populate with the rest of the unique ids 

  # is this possible?



 # got the following code in shiny it doesnt work but i am close! 

  # chosen_items <- reactive({

  #   

  #   if(input$select_by == "Food"){

  #     

  #     # obtain all of the underlying price values 

  #     unlist(lapply(1:length(unique(na.omit(nodes_data_reactive()$Food ))), 

  #                   function(i){

  #                     

  #                     eval(parse(text = paste("input$`", unique(na.omit(

  #                       

  #                       nodes_data_reactive()$Food

  #                       

  #                     ))[i], "`", sep = ""

  #                     

  #                     

  #                     )))

  #                     

  #                   } # end of function

  #                   

  #                   

  #                   

  #     )) # end of lapply and unlist

  #     

  #   }

  # })





} # end of server





# Run the application 

shinyApp(ui = ui, server = server)