r - 在 Shiny 中使用 varSelectInput 过滤数据？

Question

我想使用用户选择的变量来过滤(然后绘制)数据。但是我收到一个错误，即“列表”对象不能被强制输入“double”。这是一个虚拟示例，我想说的是:“如果用户从变量列表中选择“齿轮”，则显示齿轮 = 4 的所有汽车的马力直方图。

library(shiny)

mtcars_cols <- mtcars %>% select(gear, carb)

# Define UI for application that draws a histogram
ui <- fluidPage(
   
   # Application title
   titlePanel("Motor Car Trend Road Tests"),
   
   # Sidebar 
   sidebarLayout(
      varSelectInput("variables", 
                     "Select variables: ", 
                     mtcars_cols,
                     multiple = TRUE),
      
      # Show a plot of the generated distribution
      mainPanel(
         plotOutput("distPlot")
      )
   )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
   
   output$distPlot <- renderPlot({
      dt <- mtcars %>%
        filter(!!!input$variables == 4)
      
      bins <- seq(min(x), max(x), length.out = 10 + 1)
      
      # draw the histogram with the specified number of bins
      hist(dt$hp, breaks = bins, col = 'darkgray', border = 'white')
   })
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

我认为区分 varSelectInput 很重要与 multiple = TRUE和 multiple = FALSE .让我们从后一个开始(看看打印中间步骤的控制台)。只有一个变量 input$variables是一个名字。所以我们可以使用 !! input$variables == 4内dplyr::filter .

library(shiny)
library(dplyr)

mtcars_cols <- mtcars %>% select(gear, carb)

# Define UI for application that draws a histogram
ui <- fluidPage(
  
  # Application title
  titlePanel("Motor Car Trend Road Tests"),
  
  # Sidebar 
  sidebarLayout(
    varSelectInput("variables", 
                   "Select variables: ", 
                   mtcars_cols,
                   multiple = FALSE),
    
    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("distPlot")
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  
  output$distPlot <- renderPlot({
    
    print(input$variables)
    
    dt <- mtcars %>%
      filter(!! input$variables == 4)
    
    print(dt)

    bins <- seq(min(dt$hp), max(dt$hp), length.out = 10 + 1)
    
    # draw the histogram with the specified number of bins
    hist(dt$hp, breaks = bins, col = 'darkgray', border = 'white')
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

当我们有多个变量时，情况就不一样了。这里 input$variables是一个名字列表。如果我们要过滤所有选定变量都相等的所有行 4一个好方法是用 purrr::map 创建一个表达式列表和 bquote .我们可以在 dplyr::filter 中使用这个表达式列表喜欢 !!! expr_ls .

library(shiny)
library(dplyr)

mtcars_cols <- mtcars %>% select(gear, carb)

# Define UI for application that draws a histogram
ui <- fluidPage(
  
  # Application title
  titlePanel("Motor Car Trend Road Tests"),
  
  # Sidebar 
  sidebarLayout(
    varSelectInput("variables", 
                   "Select variables: ", 
                   mtcars_cols,
                   multiple = TRUE),
    
    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("distPlot")
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  
  output$distPlot <- renderPlot({
    
    req(input$variables)
    print(input$variables)
    
    expr_ls <- purrr::map(input$variables, ~ bquote(.(.x) == 4))
    
    dt <- mtcars %>%
      filter(!!! expr_ls)

    print(dt)

    bins <- seq(min(dt$hp), max(dt$hp), length.out = 10 + 1)

    # draw the histogram with the specified number of bins
    hist(dt$hp, breaks = bins, col = 'darkgray', border = 'white')
  })
}

# Run the application 
shinyApp(ui = ui, server = server)