Как выбрать все входные данные сразу из функции selectInput в R

Question

В блестящем приложении, которое я создаю, у меня есть набор раскрывающихся списков, которые связаны друг с другом. То есть, ввод одного раскрывающегося списка решает набор ввода для других.

Для раскрывающихся списков я использую функцию selectInput (), а также есть раскрывающиеся списки, из которых мне нужно выбратьнесколько опций.

Но когда количество опций больше, пользователь должен выбрать каждую опцию отдельно. Есть ли способ выбрать все варианты одновременно.

Это как бы вариант "ВСЕ". который выбирает все.

Я не хочу использовать функцию "pickerInput", пожалуйста.

Поскольку мои параметры в раскрывающемся списке зависят от предыдущего раскрывающегося ввода, я не могу создать статический список выбора.

В качестве обходного пути я использовал поле ввода флажка длявыберите все значения в раскрывающемся списке, но, к сожалению, это не работает.

Пожалуйста, найдите приведенный ниже интерфейс и код сервера.

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())
})
}

Любые предложения помогут, пожалуйста.

Заранее спасибо

Дэвид

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)