5

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

对于下拉框，我使用 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())
})
}

任何建议都会有所帮助。

提前致谢

大卫

4

2 回答 2

3

这是一种通过单击按钮来选择所有项目的方法：

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)

在此处输入图像描述

于 2019-10-17T19:24:46.487 回答
0

您可以将“所有产品”之类的内容添加到您的选择向量中，然后通过过滤您的数据框来生成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)
于 2019-10-17T02:26:37.393 回答