How to obtain values wen selecting a checkbox?

shiny
rstudio

#1

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)

Any ideas as to how i can actually get those values in a reactive that will update when i press and un press new checkboxes including the select all button? i tried it above and commented it out - it didn't work at all - really stuck over here!


#2

Does the output panel need to access all of the different tabs' checkboxes at once? Or just the checkbox values that are on the currently displayed tab? (This determines whether we'll use a single reactive expression that knows which tab is active and only uses that set of checkboxes)


#3

Thank you Jcheng for the response, this response may be a bit long so bear with me!

So in the current app - there is a dataframe called nodes_data_reactive, as of now, when a user selects a checkbox in the TabPanel (for example for in the Energy Tab, they select the checkbox option Stock Broker) - i would want the underlying value to be outputted, this underlying value corresponds to the value in the "Salary" column - which here is 2)

What i want to do is get that value 2 into some sort of reactive that updates when more are selected, so if they select a few more checkboxes (across different tabs) then it will update the reactive and you would get those underlying "Salary" values for the checkboxes you have selected - but this would also have to work when a person clicks the select all button (which pulls all the values for those checkboxes in that specific tab and can also deselect them)

So just the checkbox values that are on the currently displayed tab i guess? I'm a beginner in shiny so its a bit hard for me to say - but i just want to create a reactive, that updates when a user selects a checkbox (or multiple checkboxes - across different tabs - this reactive is the "Salary" values for those assosciated checkboxes) and then this reactive will also work when a user clicks select all (on any of the tabs, or even multiple tabs) so if they want to select all on the first tab and second tab then the reactive will update with all those values in those two tabs - again if they press select all again (which un selects the checkboxes) then the reactive will update and remove those values.

i have spent ages trying to get something going - its proving super hard

really grateful for any advice you can give me on this! Thank you so much!


#4

You should think of the "Select All" feature as driving the other checkboxes using observeEvent. I've changed the UI to buttons, as I think it makes it clearer to the user.

I've wrapped this up as a Shiny module, which is a bit of an advanced topic, but is great for situations like this where you want to reuse a bit of UI + logic across several tabs or whatever.

library(shiny)

optionsGroupUI <- function(id, label, choices, selected = NULL, ...) {
  ns <- NS(id)
  
  tagList(
    checkboxGroupInput(
      ns("choices"),
      label,
      choices,
      selected,
      ...
    ),
    div(class = "btn-group", role = "group",
      actionButton(ns("select_all"), "Select all", class = "btn-xs"),
      actionButton(ns("deselect_all"), "Deselect all", class = "btn-xs")
    )
  )
}

# This is a module server function; you never call it directly, but instead
# use callModule.
#
# The `choices` parameter should be the same choices passed to the
# corresponding `optionsGroupUI` call.
#
# The return value is a reactive expression for the user's selection.
optionsGroup <- function(input, output, session, choices) {
  observeEvent(input$select_all, {
    updateCheckboxGroupInput(session, "choices", selected = choices)
  })
  
  observeEvent(input$deselect_all, {
    updateCheckboxGroupInput(session, "choices", selected = character(0))
  })

  reactive(input$choices)
}

ui <- fluidPage(
  fluidRow(
    column(6,
      tabsetPanel(
        tabPanel("Iris",
          optionsGroupUI("one", "Iris variables", names(iris))
        ),
        tabPanel("airquality",
          optionsGroupUI("two", "airquality variables", names(airquality))
        )
      )
    ),
    column(6,
      h3("Selected:"),
      verbatimTextOutput("result", placeholder = TRUE)
    )
  )
)

server <- function(input, output, session) {
  # These lines provide the server-side initialization of the modules,
  # and the `one` and `two` variables are reactive expressions that
  # yield the selected option(s).
  one <- callModule(optionsGroup, "one", choices = names(iris))
  two <- callModule(optionsGroup, "two", choices = names(airquality))
  
  output$result <- renderPrint({
    selected <- c(one(), two())
    cat(paste0(selected, collapse = "\n"))
  })
}

shinyApp(ui, server)

#5

Thanks @jcheng ! Really grateful for the advice here - never knew about the shiny call module so will play around with it and try and test it out

Do you know how i can actually get those tabPanels to generate like i did before in the lapply for the tabPanel but using this format? Because i can only generate those tab panels programatically and not hard coded into the UI - so i am unsure i i need to do an lapply in the tabsetPanel again or if i am even supposed to? any ideas on how i can generate all those checkboxes in those tabpanels too?


#7

@jcheng Any thoughts on how to use this shiny call module within the remit of having the checkboxes created within the renderUI in the server section - or if there are any good alternatives to this form of checkbox creation? I can only create the boxes and tab panels in the server side only