在闪亮复选框列中也允许全/无复选框时预选复选框答案

【问题标题】：Pre-select checkboxes when also allowing all/none checkbox in Shiny checkbox columns在闪亮复选框列中也允许全/无复选框时预选复选框
【发布时间】：2021-03-08 09:46:35
【问题描述】：

我已经实现了带有全/无复选框的两列。现在我希望能够在应用启动时使用selected_states 预先选择一些复选框。

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

如何保持全/无功能并允许预选复选框？

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)

【问题讨论】：

标签： r shiny

【解决方案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)

【讨论】：

【解决方案2】：

我可能会将单个 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)

【讨论】：