r语言 - 在闪亮的复选框列中允许所有/无复选框时，预先选择复选框

Question

我实现了两个带有all/none复选框的列。现在我希望能够有一些复选框预选使用，selected_states，当应用程序启动。

使用selected =的正常方法由于all/none选择器的实现方式而失败。

我如何保持所有/无功能，并允许复选框预选?

library(shiny)
library(shinyWidgets)
library(tidyverse)
df <- tibble(
state = c("Alabama", "Alaska", "Arizona", "Arkansas",
"California", "Colorado", "Connecticut", "Delaware", "Florida",
"Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa",
"Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts",
"Michigan", "Minnesota", "Mississippi", "Missouri", "Montana",
"Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico",
"New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma",
"Oregon", "Pennsylvania", "Rhode Island", "South Carolina", "South Dakota",
"Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington",
"West Virginia", "Wisconsin", "Wyoming")
)
selected_states <- c("Alabama", "Alaska","Minnesota")

ui <- fluidPage(

wellPanel(
checkboxInput('all_none', 'All/None'),
tags$label("Choose :"),
fluidRow(
column(
width = 4,
checkboxGroupInput(
selected = selected_states,
inputId = "checka",
label = NULL,
choices = df$state[1:13]
)
),

column(
width = 4,
checkboxGroupInput(
selected = selected_states,
inputId = "checkb",
label = NULL,
choices = df$state[14:25]
)
)
)
),
textOutput("selected")
)
server <- function(input, output, session) {
observe({
updateCheckboxGroupInput(
session, 'checka', choices = df$state[1:13],
selected = if (input$all_none == TRUE) df$state
)
})
observe({
updateCheckboxGroupInput(
session, 'checkb', choices = df$state[14:25],
selected = if (input$all_none == TRUE) df$state
)
})

output$selected <- renderText({
all_selected <- paste(c(input$checka, input$checkb), collapse = ", ")
})
}
shinyApp(ui, server)

Answer 1

您应该移动选择/取消选择所有状态的代码，以便在单击all/None复选框时运行。

要在启动时停止该代码的运行，可以使用ignoreInit参数。

library(shiny)
library(tidyverse)
df <- tibble(
state = c("Alabama", "Alaska", "Arizona", "Arkansas",
"California", "Colorado", "Connecticut", "Delaware", "Florida",
"Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa",
"Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts",
"Michigan", "Minnesota", "Mississippi", "Missouri", "Montana",
"Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico",
"New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma",
"Oregon", "Pennsylvania", "Rhode Island", "South Carolina", "South Dakota",
"Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington",
"West Virginia", "Wisconsin", "Wyoming")
)
selected_states <- c("Alabama", "Alaska","Minnesota")
ui <- fluidPage(

wellPanel(
checkboxInput('all_none', 'All/None'),
tags$label("Choose :"),
fluidRow(
column(
width = 4,
checkboxGroupInput(
selected = selected_states,
inputId = "checka",
label = NULL,
choices = df$state[1:13]
)
),

column(
width = 4,
checkboxGroupInput(
selected = selected_states,
inputId = "checkb",
label = NULL,
choices = df$state[14:25]
)
)
)
),
textOutput("selected")
)
server <- function(input, output, session) {
observeEvent(input$all_none,{
updateCheckboxGroupInput(
session, 'checka', choices = df$state[1:13],
selected = if (input$all_none == TRUE) df$state
) 
updateCheckboxGroupInput(
session, 'checkb', choices = df$state[14:25],
selected = if (input$all_none == TRUE) df$state
)
}, ignoreInit = 1)
output$selected <- renderText({
all_selected <- paste(c(input$checka, input$checkb), collapse = ", ")
})
}
shinyApp(ui, server)

Answer 2

我可能会用单独的actionButtons来替换单个的All/None按钮。和";"选择"无"。代码看起来像这样:

library(shiny)
library(shinyWidgets)
library(tidyverse)
df <- tibble(
state = c("Alabama", "Alaska", "Arizona", "Arkansas",
"California", "Colorado", "Connecticut", "Delaware", "Florida",
"Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa",
"Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts",
"Michigan", "Minnesota", "Mississippi", "Missouri", "Montana",
"Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico",
"New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma",
"Oregon", "Pennsylvania", "Rhode Island", "South Carolina", "South Dakota",
"Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington",
"West Virginia", "Wisconsin", "Wyoming")
)
selected_states <- c("Alabama", "Alaska","Minnesota")
ui <- fluidPage(

wellPanel(
actionButton('selectall','Select All'),
actionButton('selectnone','Select None'),
br(),
br(),
tags$label("Choose :"),
fluidRow(
column(
width = 4,
checkboxGroupInput(
selected = selected_states,
inputId = "checka",
label = NULL,
choices = df$state[1:13]
)
),

column(
width = 4,
checkboxGroupInput(
selected = selected_states,
inputId = "checkb",
label = NULL,
choices = df$state[14:25]
)
)
)
),
textOutput("selected")
)
library(shiny)
?updateCheckboxGroupInput
server <- function(input, output, session) {

observeEvent(
input$selectall, {
updateCheckboxGroupInput(
session, 'checka',
choices = df$state[1:13],
selected = df$state)
}
)
observeEvent(
input$selectall, {
updateCheckboxGroupInput(
session, 'checkb',
choices = df$state[14:25],
selected = df$state)
}
)
observeEvent(
input$selectnone, {
updateCheckboxGroupInput(
session, 'checka',
choices = df$state[1:13],
selected = character(0))
}
)
observeEvent(
input$selectnone, {
updateCheckboxGroupInput(
session, 'checkb',
choices = df$state[14:25],
selected = character(0))
}
)

output$selected <- renderText({
all_selected <- paste(c(input$checka, input$checkb), collapse = ", ")
})
}
shinyApp(ui, server)

顺便说一句，如果您希望所有25个状态出现在一个选择器中，但格式化为两列，您可以使用CSS属性column-count应用于checkboxGroupInput-这将允许您使用单个选择器，从而简化代码，但导致相同的外观:

library(shiny)
library(shinyWidgets)
library(tidyverse)
df <- tibble(
state = c("Alabama", "Alaska", "Arizona", "Arkansas",
"California", "Colorado", "Connecticut", "Delaware", "Florida",
"Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa",
"Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts",
"Michigan", "Minnesota", "Mississippi", "Missouri", "Montana",
"Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico",
"New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma",
"Oregon", "Pennsylvania", "Rhode Island", "South Carolina", "South Dakota",
"Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington",
"West Virginia", "Wisconsin", "Wyoming")
)
selected_states <- c("Alabama", "Alaska","Minnesota")
ui <- fluidPage(
tags$head(
tags$style(HTML("
div .shiny-options-group {
column-count: 2;
}
"))
),

wellPanel(
actionButton('selectall','Select All'),
actionButton('selectnone','Select None'),
br(),
br(),
tags$label("Choose :"),
fluidRow(
column(
width = 8,
checkboxGroupInput(
selected = selected_states,
inputId = "checka",
label = NULL,
choices = df$state[1:25]
)
)
)
),
textOutput("selected")
)
library(shiny)
?updateCheckboxGroupInput
server <- function(input, output, session) {

observeEvent(
input$selectall, {
updateCheckboxGroupInput(
session, 'checka',
choices = df$state[1:25],
selected = df$state)
}
)
observeEvent(
input$selectnone, {
updateCheckboxGroupInput(
session, 'checka',
choices = df$state[1:25],
selected = character(0))
}
)
output$selected <- renderText({
all_selected <- paste(c(input$checka, input$checkb), collapse = ", ")
})
}
shinyApp(ui, server)