在闪亮的 R 中使用 selectInput 来选择和过滤行，而不是选择列

Question

我正在尝试使用闪亮的 selectInput 函数从数据框中过滤行，例如“mtcars”。因此，用户将选择他想要查看的汽车，并且 outputTable 将仅显示所选汽车的统计信息。在 selectInput 示例中，选择作用于列：

## Only run examples in interactive R sessions
if (interactive()) {

# basic example
shinyApp(
  ui = fluidPage(
    selectInput("variable", "Variable:",
                c("Cylinders" = "cyl",
                  "Transmission" = "am",
                  "Gears" = "gear")),
    tableOutput("data")
  ),
  server = function(input, output) {
    output$data <- renderTable({
      mtcars[, c("mpg", input$variable), drop = FALSE]
    }, rownames = TRUE)
  }
)
}

但是，我正在尝试使用 dplyr 根据用户输入选择的汽车来过滤掉汽车：

library(shiny)
library(dplyr)

#####Just adding a column name to mtcars for the cars column####
#cars <- mtcars
#mtcars <-setNames(cbind(rownames(cars), cars, row.names = NULL), 
#                  c("cars", "mpg", "cyl", "disp", "hp", "drat", "wt", "qsec", "vs", "am", "gear", "carb"))

if (interactive()) {

  shinyApp(
    ui = fluidPage(
      selectInput("variable", "Pick a Car: ",
                  c("All" = "All Cars",
                    "Ford" = "Ford",
                    "Volvo" = "Volvo",
                    "Ferrari" = "Ferrari",
                    "Fiat" = "Fiat",
                    "Merc" = "Merc")),
      tableOutput("data")
    ),


    server = function(input, output) {

      output$cars <- renderText({
        mtcars %>%
          filter(mtcars$cars %in% as.character(input$variable))
      })

      output$data <- renderTable({
        output$cars
      })

    }
  )
}

任何建议将不胜感激！

Answer 1

首先，第二个示例中的 input$variable 不为人所知，因为您的 selectInput-ID 是“汽车”。然后你不使用 renderText 输出，所以过滤永远不会发生。最后，mtcars 数据中没有可能的选择。所以无论如何，它永远不会为表找到任何数据。

我编写了一个可重现的示例，将可选选项更改为 mtcars 数据的实际名称。

rm(list=ls())
cars <- mtcars
mtcars <-setNames(cbind(rownames(cars), cars, row.names = NULL),
                 c("cars", "mpg", "cyl", "disp", "hp", "drat", "wt", "qsec", "vs", "am", "gear", "carb"))
library(shiny)
library(DT)
if (interactive()) {

  shinyApp(
    ui = fluidPage(
      selectInput(inputId = "variable", label = "Pick a Car: ",choices = 
                    c("Mazda RX4 Wag" = "Mazda RX4 Wag",
                    "Merc 280" = "Merc 280",
                    "Volvo 142E" = "Volvo 142E",
                    "Duster 360" = "Duster 360",
                    "Lotus Europa" = "Lotus Europa"), selected = "Mazda RX4 Wag"),
      verbatimTextOutput("cars"),
      tableOutput("data")
    ),


    server = function(input, output) {

      carReact <- reactiveValues(car=NULL)

      output$cars <- renderText({
        txt <- mtcars[mtcars$cars %in% as.character(input$variable),]
        ## Use regex() or match() for example, if you only want partial matching of the car names.

        carReact$car <- txt
        paste(txt, collapse = ";")
      })

      output$data <- renderTable({
        req(carReact$car)
        datatbl <- carReact$car
        as.data.frame(datatbl)
      })

    }
  )
}

选定的汽车名称保存在 reactiveValue (carReact) 中，并在 renderText 函数中分配。并且 renderText 不能打印出列表，所以你必须把它只给 1 个变量或者使用 paste() 函数。

Answer 2

您只需要renderTable() 并将过滤后的数据帧传递给它。
要过滤数据框，我们需要找到行名中存在input$cars 的那些行（或添加的列car）。
但这在选择All时不起作用，这就是我们使用条件input$cars == 'All Cars'的原因。

这应该可行：

shinyApp(
  ui = fluidPage(
    selectInput("cars", "Pick a Car: ",
                c("All" = "All Cars",
                  "Ford" = "Ford",
                  "Volvo" = "Volvo",
                  "Ferrari" = "Ferrari",
                  "Fiat" = "Fiat",
                  "Merc" = "Merc")),
    tableOutput("data")
  ),


  server = function(input, output) {

    mtcars$car <- rownames(mtcars)

    output$data <- renderTable({
      mtcars %>%
        filter(stringr::str_detect(car, as.character(input$cars)) | input$cars == 'All Cars')
    })

  }
)