当前具有以下代码-是否可以通过任何方式重置此应用中的所有checkboxes-不管是在一个标签上还是在多个标签上进行选择？
所以我已经在应用程序中引入了全选和取消全选按钮，因此希望该功能仍将保留在其中吗？
代码：
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")),
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("checkboxfood_", i),
label = NULL,
choices = nodes_data_reactive() %>%
filter(Food == food[i]) %>%
select(Product_name) %>%
unlist(use.names = FALSE)),
checkboxInput(paste0("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("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("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("all_", i)]])){
if(input[[paste0("all_", i)]] == TRUE) {
updateCheckboxGroupInput(session,
paste0("checkboxfood_", i),
label = NULL,
choices = product_choices,
selected = product_choices)
} else {
updateCheckboxGroupInput(session,
paste0("checkboxfood_", i),
label = NULL,
choices =product_choices)
}
}
})
})
} # end of server
# Run the application
shinyApp(ui = ui, server = server)
答案 0 :(得分：1)
以下是针对您的复选框的基于固定命名约定的解决方案（我添加了“ chk_”前缀）
编辑：区分updateCheckboxInput和updateCheckboxGroupInput
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)