如何从R中的selectInput函数一次选择所有输入

Question

在我正在创建的闪亮应用程序中，我有一组彼此互连的下拉列表框。即一个下拉框的输入决定了其他下拉框的一组输入。

对于下拉框，我使用 selectInput() 函数来执行此操作，并且还有一些下拉框，我需要从中选择多个选项。

但当选项数量较多时，用户需要单独选择每个选项。有什么办法可以一次选择所有选项。

这有点像“全部”选项。它选择一切。

我不想使用"pickerInput"函数。

由于下拉列表中的选项取决于之前的下拉输入，因此我无法创建静态选择列表。

作为解决方法，我使用复选框输入来选择下拉列表中的所有值，但不幸的是它不起作用。

请在下面找到 UI 和服务器代码。

Source_Data <-
data.frame(
key = c(1, 1, 1, 2, 2, 2, 3, 3, 3),
Product_Name = c(
  "Table",
  "Table",
  "Chair",
  "Table",
  "Bed",
  "Bed",
  "Sofa",
  "Chair",
  "Sofa"
),
Product_desc = c("XX", "XX", "YY", "XX", "Z", "ZZZ", "A", "Y", "AA"),
Cost = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
)

UI 和服务器代码

ui <- fluidPage(titlePanel("Demo"),
            sidebarLayout(
              sidebarPanel(
                sliderInput(
                  "key",
                  "keys",
                  min = 1,
                  max = 3,
                  value = c(1, 3),
                  step = 1
                ),
                selectInput("Product", "List of Products", choices = NULL),
                selectInput(
                  "Product_d",
                  "Product Description",
                  choices = NULL,
                  multiple = TRUE,
                  selected = TRUE
                ),
                checkboxInput('all', 'Select All/None'),
                actionButton("Button", "ok")
              ),
              mainPanel(tabsetPanel(
                type = "tabs",
                tabPanel("table_data", DT::dataTableOutput("table"))
              ))

            ))



server <- function(input, output, session) {
observeEvent(input$key, {
updateSelectInput(
  session,
  "Product",
  "List of Products",
  choices = unique(
    Source_Data %>% filter(key %in% input$key) %>% select
    (Product_Name)
  )
)
})

observeEvent(c(input$key, input$Product, input$all), {
updateSelectInput(
  session,
  "Product_d",
  "Product Description",
  choices = unique(
    Source_Data %>% filter(key %in% input$key,
                           Product_Name %in% input$Product) %>% select
    (Product_desc)
  ),
  selected = if (input$all)
    unique(
      Source_Data %>% filter(key %in% input$key,
                             Product_Name %in% input$Product) %>% select
      (Product_desc)

    )

}))

output_func <- eventReactive(input$Button, {
key_input <- input$key
Product_input <- input$Product
Product_desc_input <- input$Product_d
cat_input <- input$Product_desc
div_input <- input$divisions

z <-
  Source_Data %>% dplyr::arrange (key) %>% dplyr::select(key,
                                                         Product_Name,
                                                         Product_Desc,
                                                         Cost) %>% 
dplyr::filter (
                                                           key %inrange% 
key_input,
                                                           Product_Name == 
Product_input,
                                                           Product_Desc == 
Product_desc_input
                                                         )

return(z)
})

output$table_data <-
DT::renderDataTable({
  DT::datatable(output_func())
})
}

任何建议都会有所帮助。

提前致谢

大卫

Answer 1

以下是通过单击按钮选择所有项目的方法：

library(shiny)

js1 <- paste0(c(
  "Selectize.prototype.selectall = function(){",
  "  var self = this;",
  "  self.setValue(Object.keys(self.options));",
  "}"), 
  collapse = "\n")

js2 <- paste0(c(
  "var selectinput = document.getElementById('select');",
  "selectinput.selectize.setValue(-1, false);",
  "selectinput.selectize.selectall();",
  "$('#select + .selectize-control .item').removeClass('active');"),
  collapse = "\n")

ui <- fluidPage(
  tags$head(tags$script(js1)),
  actionButton("selectall", "Select all", onclick = js2),
  br(),
  selectizeInput("select", "Select", choices = month.name, multiple = TRUE, 
                 options = list(
                   plugins = list("remove_button")
                 )
  )
)

server <- function(input, output){}

shinyApp(ui, server)

Answer 2

您可以将“所有产品”之类的内容添加到您的选择向量中，然后通过过滤数据帧selectizeInput来生成辅助向量。renderUI（我还将您的 df 转换为字符，以便unique()可以正常工作。）

df <- Source_Data %>% mutate_all(as.character)

library(shiny)
library(dplyr)

ui <- {
    fluidPage(
        selectizeInput('product_name', 'Product name', choices = c('All products', unique(df$Product_Name)), selected = 'All products', multiple = TRUE),
        uiOutput('secondary_select')
    )
}

server <- function(input, output, session) {
    output$secondary_select <- renderUI({
        if ('All products' %in% input$product_name) {
            prod_desc <- unique(df$Product_desc)
        } else {
            df <- df %>% filter(Product_Name == input$product_name)
            prod_desc <- unique(df$Product_desc)
        }
        selectizeInput('product_desc', 'Product description', choices = c('All descriptions', prod_desc))
    })
}

shinyApp(ui, server)