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

Posted 2023-02-24

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

【英文标题】：Using selectInput in shiny R to select and filter rows, not select columns

【发布时间】：2018-10-25 05:26:15

【问题描述】：

我正在尝试使用闪亮的 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
      )

    
  )

任何建议将不胜感激！

【参考方案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() 函数。

【参考方案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')
    )

  
)

【讨论】：

如果你将 stringr::str_detect(car..) 改为 stringr::str_detect(cars..) 就可以了。

@GGamba 如果我想使用这种技术来消除传单地图而不是表格上的标记怎么办？

虽然基本概念相同，但对传单对象进行操作可能是一项截然不同的任务，值得自己提出问题

似乎已经弄清楚了，但如果没有您的帮助，这将是不可能的。谢谢！