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

Question

在我正在创建的 Shiny 应用程序中，我有一组相互关联的下拉列表框。即一个下拉框的输入决定了其他人的输入集。

对于下拉框，我使用 selectInput() 函数来完成它，还有一些下拉框，我需要从中选择多个选项。

But when the number of options are more the user is required to select each and every option individually.有没有办法一次选择所有选项。

那是一种“全部”选项。选择一切。

我不想用 "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)