2

I have a simple shiny that presents descriptive statistics using reactive. However, I would like to use ifelse within tidyverse pipe (and not writing tons of codes). However, I´m not being able to do that. I checked previous post but it´s not working as well. I imagine this part is close to what I want:

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

This code is 100% working,

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)
  • Please check the akrun response below. Everything is working.
Luis
  • 1,388
  • 10
  • 30

2 Answers2

2

We may need to use {} to block the code between the %>%

 students_results <- reactive({
    ds %>%
      {
        if (input$all_quest == TRUE) {
          . 
            } else {
          {.} %>%
           filter(domain == input$domain) %>%
           group_by(input$quest) 
       } 
        
        }%>%
    summarise(mean(test))
  })
akrun
  • 874,273
  • 37
  • 540
  • 662
  • Almost, but not working. It does nothing. I know it's very hard to capture what I wrote, then this gif may help. https://gifyu.com/image/SS6Rf – Luis Dec 27 '21 at 19:39
  • @Luis The code I was translating based on your descripiton was `if` the all_quest is TRUE, then return the original dataset (`.` - ds) and get the `mean` of the whole column 'test' or `else` do some `filter` in between and grouping. Is that what you wrote in your first block of code – akrun Dec 27 '21 at 19:41
  • @Luis I think it is better to change your description in the post. It is confusing because your code block logic asks to summarise without grouping and summarise returns only the column mean and no other columns – akrun Dec 27 '21 at 19:47
  • 1
    Oh yes, @akrun, and you did it right! I just realized your code is working. (For the 100times, thank you again!!) I´ll change the description and accept your answer!!!! – Luis Dec 27 '21 at 19:48
1

Another option is purrr::when which can help to build case_when like pipes. Note that I changed the example code slightly to better show how its working.

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)
TimTeaFan
  • 17,549
  • 4
  • 18
  • 39
  • Amazing!! Thank you for providing this example. I really find the `when` function very intuitive! – Luis Dec 28 '21 at 14:41