在闪亮的应用程序中使用 if else 的条件值使用 tidyverse 和 dplyr 对数据集进行分组和过滤

Conditional values using if else within shiny app using tidyverse and dplyr to group and filter a dataset

我有一个简单的 shiny,它使用反应式呈现描述性统计数据。但是,我想在 tidyverse 管道中使用 ifelse (而不是编写大量代码)。但是,我无法做到这一点。我检查了之前的 ,但效果不佳。我想这部分接近我想要的:

 students_results <- reactive({
    ds %>%
      
    if (input$all_quest == TRUE) {  do nothing here!! } else {  
      filter(domain == input$domain) %>%
        group_by(input$quest)
    }
    summarise(mean(test))

此代码 100% 有效,

library(shiny)
library(tidyverse)
library(DT)
ds <- data.frame(quest = c(2,4,6,8), domain = c("language", "motor"), test = rnorm(120, 10,1))

ui <- fluidPage(
  
  sidebarLayout(
    tabPanel("student",
             sidebarPanel(
               selectInput("domain", "domain", selected = "language", choices = c("language", "motor")),
               selectInput("quest", "Questionnaire", selected = "2", choices = unique(ds$quest)),
               checkboxInput("all_quest",
                             label = "Show all questionnaires",
                             value = FALSE)
             )
    ),
    
    mainPanel(
      dataTableOutput("table")
    )
  )
)
server <- function(input, output) {
  
  students_results <- reactive({
    if (input$all_quest == TRUE) {
      ds %>% 
        group_by(quest, domain) %>% 
        summarise(mean(test))
    } 
    else   {
      ds %>% 
        filter(domain == input$domain) %>%
        group_by(input$quest) %>% 
        summarise(mean(test))
      
    }
  })
  
  output$table <- renderDataTable({
    students_results()
  }
  )
}
shinyApp(ui = ui, server = server)

我们可能需要用{}来屏蔽%>%

之间的代码
 students_results <- reactive({
    ds %>%
      {
        if (input$all_quest == TRUE) {
          . 
            } else {
          {.} %>%
           filter(domain == input$domain) %>%
           group_by(input$quest) 
       } 
        
        }%>%
    summarise(mean(test))
  })

另一个选项是 purrr::when,它可以帮助构建 case_when 类管道。请注意,我稍微更改了示例代码以更好地展示其工作原理。

library(shiny)
library(tidyverse)
library(DT)

ds <- data.frame(quest = c(2,4,6,8), domain = c("language", "motor"), test = rnorm(120, 10,1))


ui <- fluidPage(
  
  sidebarLayout(
    tabPanel("student",
             sidebarPanel(
               selectInput("domain", "domain", selected = "language", choices = c("language", "motor")),
               selectInput("quest", "Questionnaire", selected = "2", choices = unique(ds$quest)),
               checkboxInput("all_quest",
                             label = "Show all questionnaires",
                             value = FALSE)
             )
    ),
    
    mainPanel(
      dataTableOutput("table")
    )
  )
)

server <- function(input, output) {
  
  students_results <- reactive({
    ds %>% 
      when(input$all_quest == TRUE ~ .,
           ~ filter(., domain == input$domain) %>%
                filter(quest == input$quest) %>% 
                summarise(mean(test))
           ) 
  })
  
  output$table <- renderDataTable({
    students_results()
  }
  )
}

shinyApp(ui = ui, server = server)