R ShinyWidgets pickerInput：全选时如何不过滤数据框

Question

我有以下应用程序可根据pickerInput的输入绘制直方图。 想象一下，数据帧很大，如果我选择全部，那么将所有选择传递给filter语句要花一些时间。 是否有可以执行类似操作的全选标志：如果pickerinput $ select_all为true，则x = df; 否则x = df％>％过滤器（ID％in％输入$ 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)