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:
-
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)
-
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!