在 Shiny 的反应函数中使用 dplyr 条件过滤器

Gia*_*omo 4 r shiny dplyr magrittr reactive

我在 Shiny 应用程序响应函数中使用 dplyr。我在 UI 中有一个交互式小部件,用户可以使用它来选择状态,数据将根据所选状态显示。但是,我也想提供显示所有内容的选项,我将这种状态称为“全部”。

我知道如何在没有 dplyr 的情况下实现这一点:

library(tibble)
library(shiny)

# Test Data -----
test_data <- tribble(
  ~id, ~status,
  1, 'active',
  2, 'inactive',
  3, 'test'
)

# Ui ----
ui = fluidPage(
  selectInput("status", "Choose a status:",
              choices = list("All","active","inactive","test")
  ),
  tableOutput('result')
)

# Server ----
server = function(input, output) {

  table <- reactive({
    if(input$status != 'All')
    {
      test_data <- test_data[test_data$status == input$status,]
    } else {
      test_data
    }
  })

  output$result <- renderTable(table(), rownames = FALSE)

}

# App ---
shinyApp(ui = ui, server = server)
Run Code Online (Sandbox Code Playgroud)

但是,我希望与我的其余代码保持一致并使用 dplyr。有没有办法做类似下面的事情?

library(tibble)
library(dplyr)
library(shiny)

# Test Data -----
test_data <- tribble(
  ~id, ~status,
  1, 'active',
  2, 'inactive',
  3, 'test'
)

# Ui ----
ui = fluidPage(
  selectInput("status", "Choose a status:",
              choices = list("All","active","inactive","test")
  ),
  tableOutput('result')
)

# Server ----
server = function(input, output) {

  table <- reactive({
    test_data %>%
      filter(ifelse(input$status != 'All', status == input$status, status == ***pass***))
  })

  output$result <- renderTable(table(), rownames = FALSE)

}

# App ---
shinyApp(ui = ui, server = server)
Run Code Online (Sandbox Code Playgroud)

换句话说,有没有办法在过滤器函数中使用 ifelse 在特定条件下不过滤?

谢谢!

Kon*_*rad 5

如果您希望根据外部值有条件地应用过滤器,您可以尝试使用语法:

TRUE

table <- reactive({
  test_data %>%
    filter(if(input$status != 'All')  (status == input$status) else TRUE)
}) 
Run Code Online (Sandbox Code Playgroud)

TRUE作为条件传递将不会过滤任何行。

{}

替代方法使用{}并返回未触及的数据集:else .

table <- reactive({
  test_data %>%
  {if(input$status != 'All') filter(status == input$status) else .}
}) 
Run Code Online (Sandbox Code Playgroud)

%<>%

最后,您可以考虑打破管道并使用包中%<>%可用的运算符magrittr

if(input$status != 'All') test_data %<>% filter(status == input$status)
Run Code Online (Sandbox Code Playgroud)