当前处于以下情况：
例如-运行应用程序-按下“重置所有复选框”按钮-现在看到以下行为-
在“食用”选项卡上，“选中”标题为“培根”的框，现在切换选项卡，然后转到“油炸”选项卡，然后“选中”“全选”按钮
这将删除我们最初选中的“检查过的”培根复选框，并使用“油炸”标签作为按下任何东西的第一个实例-
确保您以后可以检查所需的内容，包括再次按下“全选”或其他复选框并删除其中的某些复选框，但是由于第一个Dplyr语句将其像“第一例”类型的情况一样使用，因此该行为是错误的在观察中
代码在下面
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",
br(),
width = 12,
height = 800
)
),
column(12, actionButton(inputId ="resetBtn", label = "Reset Selection", icon = icon("times-circle")))
)
)
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,
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("chkgrp_checkboxfood_", i),
label = NULL,
choices = nodes_data_reactive() %>%
filter(Food == food[i]) %>%
select(Product_name) %>%
unlist(use.names = FALSE)),
checkboxInput(paste0("chksingle_all_", i), "Select all", value = TRUE)
)
})))
) # 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("chkgrp_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("chkgrp_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
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)
if(!is.null(input[[paste0("chksingle_all_", i)]])){
if(input[[paste0("chksingle_all_", i)]] == TRUE) {
updateCheckboxGroupInput(session,
paste0("chkgrp_checkboxfood_", i),
label = NULL,
choices = product_choices,
selected = product_choices)
} else {
updateCheckboxGroupInput(session,
paste0("chkgrp_checkboxfood_", i),
label = NULL,
choices =product_choices)
}
}
})
})
observeEvent(input$resetBtn, ignoreNULL = TRUE, ignoreInit = TRUE, {
resetChksingleInputs <- names(input)[grepl("^chksingle*", names(input))]
cat("Resetting single checkboxes:", resetChksingleInputs, sep = "\n")
lapply(resetChksingleInputs, updateCheckboxInput, session=session, value = FALSE)
resetChkgrpInputs <- names(input)[grepl("^chkgrp*", names(input))]
cat("Resetting checkbox groups:", resetChkgrpInputs, sep = "\n")
lapply(resetChkgrpInputs, updateCheckboxGroupInput , session=session, selected = character(0))
})
} # end of server
# Run the application
shinyApp(ui = ui, server = server)
答案 0 :(得分：1)
问题出在观察者更新checkboxGroupInputs的逻辑上。 每次选中“全选”框的一个时，都会重新评估每个框的其他“全选”框-如果取消选中它们，还将取消选中checkboxGroupInputs
您会看到，当您忽略观察者内部的else语句时，选择不会被删除：
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",
br(),
width = 12,
height = 800
)
),
column(12, actionButton(inputId ="resetBtn", label = "Reset Selection", icon = icon("times-circle")))
)
)
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,
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("chkgrp_checkboxfood_", i),
label = NULL,
choices = nodes_data_reactive() %>%
filter(Food == food[i]) %>%
select(Product_name) %>%
unlist(use.names = FALSE)),
checkboxInput(paste0("chksingle_all_", i), "Select all", value = TRUE)
)
})))
) # 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("chkgrp_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("chkgrp_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
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)
if(!is.null(input[[paste0("chksingle_all_", i)]])){
if(input[[paste0("chksingle_all_", i)]] == TRUE) {
updateCheckboxGroupInput(session,
paste0("chkgrp_checkboxfood_", i),
label = NULL,
choices = product_choices,
selected = product_choices)
}
}
})
})
observeEvent(input$resetBtn, ignoreNULL = TRUE, ignoreInit = TRUE, {
resetChksingleInputs <- names(input)[grepl("^chksingle*", names(input))]
cat("Resetting single checkboxes:", resetChksingleInputs, sep = "\n")
lapply(resetChksingleInputs, updateCheckboxInput, session=session, value = FALSE)
resetChkgrpInputs <- names(input)[grepl("^chkgrp*", names(input))]
cat("Resetting checkbox groups:", resetChkgrpInputs, sep = "\n")
lapply(resetChkgrpInputs, updateCheckboxGroupInput , session=session, selected = character(0))
})
} # end of server
# Run the application
shinyApp(ui = ui, server = server)
尽管如此，如果取消选择“全部”-checkboxGroupInput，您的checkboxInput将不会跟随。要也允许通过“全部”取消选择，而又不放弃其他选项卡中的选择，则必须确定用户更改了哪个“全部”-checkboxInput，并且只能参考相应的checkboxGroupInput。例如对于每个“全部”-observeEvent()使用checkboxInput完成。