r-在闪亮的应用程序中使用if-else的条件值，使用tidyverse和dplyr对数据集进行分组和筛选

Question

我有一个简单的flash，它使用reactive呈现描述性统计信息。但是，我希望在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)

• 请检查下面的akrun响应。一切正常

Answer 1

我们可能需要使用{}来阻止%>%之间的代码

students_results <- reactive({
ds %>%
{
if (input$all_quest == TRUE) {
. 
} else {
{.} %>%
filter(domain == input$domain) %>%
group_by(input$quest) 
} 

}%>%
summarise(mean(test))
})

Answer 2

另一个选项是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)