我有以下闪亮的仪表板应用程序，此应用程序当前从我在服务器部分中创建的数据帧生成复选框-还有一个全选按钮，我要执行的操作如下：
1）创建一个反应式-（在代码中有一个我尝试过的注释部分的示例，但它没有用）-这个反应式应包含所选复选框的“ id”值（因此基础数据帧第一列中的值）
2）确保此方法适用于这些情况-当用户自己选择复选框时，然后当用户按下“全选”按钮时它也适用-因此此反应式将在以下任一情况下进行更新和填充那些情况
我已经注释掉了一些我尝试执行此操作的代码，但是遇到了错误和问题-有人知道如何实际获取那些您在复选框中选择的id值吗？这必须适用于所有标签，并且如果按下“全选”按钮或不按下
代码供参考！
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)