我下面有以下应用，它使用在闪亮服务器中创建的数据框，并使用它来生成选项卡面板，该面板依次又在每个选项卡面板中复选框（每个选项卡面板3个复选框）-每个选项卡面板中有一个“全选”框，实际上应该选中该标签面板中的所有框
所以我需要帮助-是我想要它，以便如果我在选项卡1上并“按”“全选”按钮，那么它将“选中”该选项卡面板中的所有这些框（并且当然“取消按下”该按钮将取消选择那些框）-但我也想要该功能，因此，如果您在不同选项卡中选择了多个复选框，则它将相应地更新并且不会丢失任何信息，（这包括同时在不同的标签上按全选）
因此，例如，我想要以下行为：
如果您选择“食用”标签>然后按“全选”-选中了所有3个复选框
现在，如果您选择“油炸”选项卡>然后按“奶酪”，这是各个复选框的选项之一-您现在总共选择了4个复选框，所有这些都来自“食用”选项卡，来自“油炸”标签的
因此，如果我们现在从第一个选项卡“食用”中取消选择“全选”按钮，它将丢失所有信息，并且不再选中“油炸”中的“奶酪”复选框，
这不是我想要的行为-我希望它进行相应的更新，并且由于我们未选中所有内容，因此仍选择了“奶酪”
我已经打印出了在实际应用中何时何地被选择的名称
代码如下：
有什么想法吗？
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)
答案 0 :(得分：0)
问题是您正在更新所有没有选择了全选选项的复选框组。解决方案是添加一个if条件，通过比较input[[paste0("checkboxfood_", i)]]的长度和product_choices的长度来检查是否选择了所有选项。
代码：
library(shiny)
library(shinydashboard)
library(tidyverse)
library(magrittr)
#################################################
#################### UI.R #######################
#################################################
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.R #####################
#################################################
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({
#Select Food
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 {
if((input[[paste0("all_", i)]] != TRUE) & (length(input[[paste0("checkboxfood_", i)]]) == length(product_choices)))
{
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())]
})
}
# Run the application
shinyApp(ui = ui, server = server)