【发布时间】：2018-12-12 17:19:52
【问题描述】：
我在下面有以下应用程序，它需要一个在闪亮服务器中创建的数据框，并使用它来生成选项卡面板，然后每个选项卡面板中的复选框（每个选项卡面板 3 个复选框） - 在每个选项卡面板中有一个“全选”框，它应该基本上检查该选项卡面板中的所有框
所以我需要帮助 - 如果我在选项卡 1 上并“按下”“全选”按钮，那么它会“选中”该选项卡面板中的所有这些框（以及当然“取消按下”该按钮将取消选择这些框） - 但我也想要该功能，因此如果您在不同选项卡中选择多个复选框，那么它将相应更新并且不会丢失任何信息，（这还包括在不同的选项卡上按全选）
例如，我想要以下行为：
如果您选择“Edibles”选项卡 > 然后按“全选” - 所有 3 个复选框都被选中
现在，如果您随后选择“Fried”选项卡 > 然后按“cheese”，这是单个复选框的选项之一 - 您现在将总共选择 4 个复选框，所有这些都来自“edibles”选项卡，只有来自“油炸”标签的那个
因此，如果我们现在取消选择第一个选项卡“edibles”中的“全选”按钮，它会丢失所有信息，并且不再选中“Fried”中的“cheese”复选框，
这不是我想要的行为 - 我希望它相应地更新并仍然选择“奶酪”，因为我们没有按下全选
我已经在实际应用程序的何时何地打印出正在选择的内容的名称
代码如下：
有什么想法吗？
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") {
food <- unique(as.character(nodes_data_reactive()$Food))
food_panel <- lapply(seq_along(food), function(i) {
### filter the data only once
food_dt <- dplyr::filter(nodes_data_reactive(), Food == food[i])
### Use the id, not the price, as the id is unique
food_ids <- as.character(food_dt$id)
selected_ids <- food_ids[food_ids %in% isolate({chosen_food()})] ### use isolate, so as to not be reactive to it
tabPanel(food[i],
checkboxGroupInput(
paste0("checkboxfood_", i),
label = "Random Stuff",
choiceNames = as.character(food_dt$Product_name), ### for some reason it likes characters, not factors with extra levels
choiceValues = food_ids,
selected = selected_ids
),
checkboxInput(
paste0("all_", i),
"Select all",
value = all(food_ids %in% isolate({chosen_food()}))
)
)
})
box(title = "Output PANEL",
collapsible = TRUE,
width = 12,
do.call(tabsetPanel, c(id = 't', food_panel)),
"Items: ", renderText(paste0(chosen_food(), collapse = ", ")),
"Names: ", renderText(paste0(chosen_food_names(), collapse = ", "))
) # end of Tab box
}
}) # 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) %>%
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()
)
}
}
})
})
chosen_food <- reactive({
unlist(lapply(seq_along(unique(nodes_data_reactive()$Food)), function(i) {
# retrieve checkboxfood_NUMBER value
input[[paste0("checkboxfood_", i)]]
}))
})
chosen_food_names <- reactive({
# turn selected chosen food values into names
nodes_data_reactive()$Product_name[as.numeric(chosen_food())]
})
} # end of server
# Run the application
shinyApp(ui = ui, server = server)
【问题讨论】：