How to render Checkboxes in a Tab Panel with render UI and also add a select all button in shiny dashboard?

shiny

#1

I am new to shiny and was wondering if the below is possible, i have not found any examples online via stackoverflow or any github issues either.

I have the following shiny dashboard seen below - i have 2 dataframes that are built into the app - for now these are dataframes, one called nodes_data_1 and one called edges_data_1.

the reason i want it in a renderUI is because i want it to use the reactive node_data_reactive() which is just a reactive version of nodes_data_1 - as I would probably be updating this nodes_data_1 dataframe therefore the reactive will update and then the tab panels and checkboxes will too.

The dataframe called nodes_data_1 is the one of importance here - I want a way so that when a user clicks in on the sidebar radio button "Food Type" -

Then tab panels will be created based on the unique values in the nodes_data_1$Food column - which has 5 values - so there would be 5 separate tab panels all sitting within this large tab box.

Then after doing this, within each tab panel, checkboxes would be rendered which correspond to the values in the nodes_data_1$Product_name which sit in the nodes_data_1$Food category -

So for example the app will look something like this:

Here you can see in the dashboard - that when i am on the "Edibles" Tab Panel which i have highlighted in yellow just to be clear - the available options to select are those in the data that are in the "Edibles" category for Food

In addition to getting all of the individual checkboxes - i also want a way of finding how to actually create a singular checkbox on each of the tab Panels, that is called "select all" and when this is checked, meaning its TRUE (or radio button etc) then it will automatically "check" those boxes in the associated tab Panel and not the other tab Panels, so here i am on the edibles panel and when i have checked the box select all, then all of those individual checkboxes in this tab panel have been selected and not the other checkboxes in the other tab panels:

so i would like it to have something like this as well:

Please see the following code below - i do not know how to create such a thing - any ideas are welcome - new to shiny so hope this is possible!

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("Food Type" = "Food",
                   "Gym Type" = "Gym",
                   "TV show" = "TV"))
    
  )   

)

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, 
                           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")),
                           Gym_type = as.character(paste("Gym", 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({
   nodes_data_1
 
  
  }) # end of reactive
  # create reacive of edges 
 
  edges_data_reactive <- reactive({
     
  edges_data_1
   
  }) # end of reactive
   


  # 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") {
    
      box(title = "Output PANEL", 
          collapsible = TRUE, 
          width = 12
          
               # something to do here - any ideas?
                             
                             ) # end of Tab box
             

      
    # When selecting by the strength of links connected to the issues:  
    } else if(input$select_by == "Gym") {
       box(title = "Output PANEL", collapsible = TRUE, width = 12,
          checkboxGroupInput("select_gyms", "Select gyms you want to display", choices = unique(nodes_data_reactive()$Gym_type)
                             ,
                             selected = NULL,
                             inline = FALSE
          )# end of checkboxGroupInput
      ) # end of box  
          
    } else if(input$select_by == "TV") {
       box(title = "Output PANEL", collapsible = TRUE, width = 12,
          checkboxGroupInput("select_tvs", 
                             "Select the tv shows you want to see",choices = sort(unique(nodes_data_reactive()$TV)),
                             selected = NULL,
                             inline = FALSE
          )# end of checkboxGroupInput
      ) # end of box  
      
  }  # end of else if
    
  }) # end of renderUI
  

    
} # end of server


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

I do believe this is possible in shiny so please do drop me any hints or tips or advise!


#2

Please check out these shiny functions for piece together your app:

The tabsets could be done within a renderUI, but I would try to get them as raw elements within the UI definition.


#3

Hi Barret - I actually looked at those and came up with this code:

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("Food Type" = "Food",
                   "Gym Type" = "Gym",
                   "TV show" = "TV"))
    
  )   
  
)

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, 
                             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({
    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 == "Food") {
      
      box(title = "Output PANEL", 
          collapsible = TRUE, 
          width = 12,
          
          do.call(tabsetPanel, c(id='t',lapply(1:length(unique(nodes_data_reactive()$Food)), function(i) {
            food <- unique(sort(as.character(nodes_data_reactive()$Food)))
            
            tabPanel(food[i], 
                     checkboxGroupInput(paste0("checkboxfood_", i), 
                                        label = "Random Stuff",
                                        choiceNames = unique(nodes_data_reactive()$Product_name[
                                          nodes_data_reactive()$Food == unique(nodes_data_reactive()$food)[i]]), choiceValues = unique(nodes_data_reactive()$Price[
                                            nodes_data_reactive()$Food == unique(nodes_data_reactive()$food)[i]])
                                       
                                        
                                        
                                        
                                        
                                        ),
                     checkboxInput(paste0("all_", i), "Select all", value = FALSE)
            )
          })))
          
      ) # end of Tab box
      
      
      
      # When selecting by the strength of links connected to the issues:  
    } else if(input$select_by == "Gym") {
      box(title = "Output PANEL", collapsible = TRUE, width = 12
      ) # end of box  
      
    } else if(input$select_by == "TV") {
      box(title = "Output PANEL", collapsible = TRUE, width = 12
      ) # end of box  
      
    }  # end of else if
    
  }) # end of renderUI
  
  observe({
    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)
      
      View(product_choices)
      
      if(!is.null(input[[paste0("all_", i)]])){
        if(input[[paste0("all_", i)]] == TRUE) {
          updateCheckboxGroupInput(session,
                                   paste0("checkboxfood_", i), 
                                   label = NULL, 
                                   choices = product_choices,
                                   selected = product_choices)
        } else {
          updateCheckboxGroupInput(session,
                                   paste0("checkboxfood_", i), 
                                   label = NULL, 
                                   choices = product_choices)
        }
      }
      
    })
    
    
  })
  View(product_choices)
} # end of server


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

How can i ensure that when a user clicks select all on a tab, that the underlying code is actually pulling out the Price columns values and not just the names? as i want to subset it


#4

I changed your last observe statement to the code below. When updating the checkboxes, it will update everything when using choices. To keep the prices as the value and the label as the name, both product prices and product names must be used.

  observe({
    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) %>%
        as.character()

      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) {
          updateCheckboxGroupInput(session,
                                   paste0("checkboxfood_", i), 
                                   label = NULL, 
                                   choiceNames = product_choices,
                                   choiceValues = product_prices,
                                   selected = product_prices)
        } else {
          updateCheckboxGroupInput(session,
                                   paste0("checkboxfood_", i), 
                                   label = NULL, 
                                   choiceNames = product_choices,
                                   choiceValues = product_prices,
                                   selected = c()
                                 )
        }
      }
      
    })

#5

Thanks Barret! Really cool stuff - never knew this was possible in shiny before!

I am now trying to actually get the actual values which are being selected and turning them into a list, then unlisting them so that i can use these downstream for when i want to create some plots, i have the following code - but alas it does not work - i feel i am close though! Any ideas on what the problem is here?

  
  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
      
    }
    
    
    
    
  })