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

Posted 2023-03-24

【中文标题】如何从 R 中的 selectInput 函数中一次选择所有输入

【英文标题】：How to select all the Input at once from selectInput function in R

【发布时间】：2020-02-13 20:14:45

【问题描述】：

在我正在创建的闪亮应用程序中，我有一组相互连接的下拉列表框。也就是一个下拉框的输入决定了其他人的输入集。

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

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

这有点像“全部”选项。选择所有内容。

我不想使用"pickerInput"function。

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

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

请在下方找到 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 <- 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())
)

任何建议都会有所帮助。

提前致谢

大卫

【问题讨论】：

有一个选项可以从 shinyWidgets 包中选择/取消选择 pickerInput 中的所有项目。

@laurenzo 感谢您的评论 :) 实际上我不想使用它来更改仪表板的格式。

抱歉，刚开始阅读您的问题时没有注意到。

没问题一切都好:)

【参考方案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)

【讨论】：

感谢您的回答 :) 它为我提供了一种新的思考方式。实际上我尝试了代码，但我面临的一个问题是我不确定我应该在我的 Server() 中做哪些更改。我也有选择输入，其中顶部下拉菜单中的选项/选择将决定下一个下拉菜单中的选择。所以我无法在 UI 中提及我的选择。你能建议我如何克服这个问题吗？再次感谢:)

【参考方案2】：

您可以将“所有产品”之类的内容添加到您的选择向量中，然后通过过滤您的数据框生成带有renderUI 的辅助selectizeInput。 （我还将您的 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)