R diverWidgets pickerInput: как не фильтровать фрейм данных при выделении всех

Question

У меня есть следующее приложение для построения гистограммы на основе ввода от pickerInput.Представьте, что фрейм данных очень большой, и если я выберу все, потребуется некоторое время, чтобы передать все варианты выбора в оператор фильтра.Есть ли флаг select-all, который может сделать что-то вроде: если pickerinput $ select_all имеет значение true, то x = df;иначе x = df%>% filter (ID% в% input $ id).Спасибо!

library("shiny")
library("dplyr")
library("shinyWidgets")

mychoices <- c("A", "B", "C", "D", "E","F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T",
           "U", "V", "W", "X", "Y", "Z")
df <- data.frame("ID" = mychoices, "invoice" = runif(26, 100, 200))

ui <- fluidPage(
 sidebarLayout(
  sidebarPanel(
    pickerInput(
      inputId = "id", label = "Choices :",
      choices = mychoices,
      options = list('actions-box' = TRUE),
      multiple = TRUE
    )
 ),
mainPanel(
    plotOutput("test")        
  )
 )
)

server <- function(input, output) {
  output$test <- renderPlot({
    x = df %>% filter( ID %in% input$id)
    ggplot(data = x, aes(invoice)) + geom_histogram(binwidth=30, alpha=0.6)
  })
}

shinyApp(ui = ui, server = server)

Answer 1

Одно простое решение, если сделать это в функции сервера, где вы проверяете, выбраны ли все столбцы, и только затем выбираете фильтровать или не фильтровать.

library("shiny")
library("dplyr")
library("shinyWidgets")

mychoices <- c("A", "B", "C", "D", "E","F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T",
           "U", "V", "W", "X", "Y", "Z")
df <- data.frame("ID" = mychoices, "invoice" = runif(26, 100, 200))

ui <- fluidPage(
 sidebarLayout(
  sidebarPanel(
    pickerInput(
      inputId = "id", label = "Choices :",
      choices = mychoices,
      options = list('actions-box' = TRUE),
      multiple = TRUE
    )
 ),
mainPanel(
    plotOutput("test")        
  )
 )
)



server <- function(input, output) {

  output$test <- renderPlot({

    if(all(mychoices %in% input$id)){
      x = df
    }else{
      x = df %>% filter( ID %in% input$id)
    }
    ggplot(data = x, aes(invoice)) + geom_histogram(binwidth=30, alpha=0.6)
  })
}

shinyApp(ui = ui, server = server)

Альтернатива делает это в точности какты хотел.Мы напрямую определяем, нажал ли пользователь на Select All или Deselect All.Это требует, чтобы мы подключили слушателя onclick и попросили браузер отправить сообщение на сервер через javascript.

library("shiny")
library("dplyr")
library("shinyWidgets")

mychoices <- c("A", "B", "C", "D", "E","F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T",
               "U", "V", "W", "X", "Y", "Z")
df <- data.frame("ID" = mychoices, "invoice" = runif(26, 100, 200))

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      pickerInput(
        inputId = "id", label = "Choices :",
        choices = mychoices,
        options = list('actions-box' = TRUE),
        multiple = TRUE
      )
    ),
    mainPanel(
      plotOutput("test")        
    )
  ),
  tags$script(HTML("
                window.onload = function(){ 
                  var select_all = document.getElementsByClassName('bs-select-all');
                  select_all = select_all[0];
                  select_all.onclick = function() {
                       Shiny.onInputChange('select_all',true);
                  }; 

                 var deselect_all = document.getElementsByClassName('bs-deselect-all');
                  deselect_all = deselect_all[0];
                  deselect_all.onclick = function() {
                       Shiny.onInputChange('select_all',false);
                  }; 

                  var run_once = true;

                  if(run_once){
                   var select_input = document.getElementsByClassName('filter-option');
                   select_input = select_input[0];
                   select_input.onclick = function() {
                   Shiny.onInputChange('select_all',false);
                   run_once =  false;
                   };
                  }

                }
                   "))
)

server <- function(input, output) {

  output$test <- renderPlot({

    if(length(input$select_all) != 0){
      if(input$select_all){
        x = df
      }else{
        x = df %>% filter( ID %in% input$id)
      }
      ggplot(data = x, aes(invoice)) + geom_histogram(binwidth=30, alpha=0.6)
    }


  })
}

shinyApp(ui = ui, server = server)