How to conditionally count the number of occurrences using dplyr?

Question

In the below reproducible example, the user stratifies the elements of a data frame based on inputs for (A) point-in-time period and (B) which of the 2 columns of values to stratify.

I'm trying to count only those rows marked with an "N" in the "Flag" column in those circumstances where the user has selected to stratify the "Values_2" elements; otherwise the Flag column is ignored when the user selects to stratify the "Values_1" elements.

The below code works except for counting elements flagged "N" when "Values_2" is chosen. I commented out my attempt to count elements flagged "N"... because it produces non-sensical results.

I will also only sum those "Value_2" elements flagged with "N" but I can figure that one out.

The image at the bottom better explains the question.

Any suggestions?

library(shiny)
library(tidyverse)
library(shinyWidgets)

ui <-
  fluidPage(
    uiOutput("stratPeriod"),
    uiOutput("stratValues"),
    h5(strong("Raw data frame:")), tableOutput("rawData"),
    h5(strong("Stratified data:")), tableOutput("stratData")
  )

server <- function(input, output, session) {

  dat <- reactive({
    data.frame(
      ID = c(1,1,2,2,2,2,3,3,3,3),
      Period = c("2020-03", "2020-04", "2020-01", "2020-02", "2020-03", "2020-04", "2020-01", "2020-02", "2020-03", "2020-04"),
      Values_1 = c(-6, 26, 36, 46, 56, 86, 100, 10, 20, 30),
      Values_2 = c(-6, 13, 18, 46, 28, 43, 100, 10, 10, 30),
      Flag = c("N","Y","Y","N","Y","Y","N","N","Y","N")
    )  
  })
  
  output$stratPeriod <- renderUI({
    chc <- unique(na.omit(dat()[[2]]))
    selectInput(inputId = "stratPeriod", 
                label = "Choose point-in-time:",
                choices = chc,
                selected = chc[1])
  })
  
  output$stratValues <- renderUI({
    selectInput("stratValues", 
                "Choose values type to sum:", 
                choices = c("Values_1","Values_2"),  
                selected = c("Values_1")
    )
  })
  
  output$rawData <- renderTable({dat()})
  
  output$stratData <- renderTable({
    req(input$stratValues)
    req(input$stratPeriod)
    
    filter_exp1 <- parse(text=paste0("Period",  "==", "'",input$stratPeriod, "'"))
    
    dat_1 <- reactive({dat() %>% filter(eval(filter_exp1))})
    
    min <- custom_min(dat_1()[[input$stratValues]])
    max <- custom_max(dat_1()[[input$stratValues]])
    breaks <- if(any(is.infinite(c(min,max)))) c(0, 10) else seq(min, max, length.out = 6) 
    
    tmp <- dat() %>% 
      filter(eval(filter_exp1)) %>%
      mutate(Range = cut(!!sym(input$stratValues), breaks=breaks, include.lowest=TRUE, right = TRUE, dig.lab = 5)) %>% 
      group_by(Range) %>% 
      summarise(Count = n(),Values = sum(!!sym(input$stratValues))) %>%
      # summarise(Count = if_else(!!sym(input$stratValues) == "Values_1",n(),sum(dat()[[5]]=="N")),Values = sum(!!sym(input$stratValues))) %>%
      complete(Range, fill = list(Count = 0,Values = 0)) %>% 
      ungroup %>% 
      mutate(Count_pct = Count/sum(Count)*100, Values_pct = Values/sum(Values)*100) %>% 
      dplyr::select(everything(), Count, Count_pct, Values, Values_pct) %>%
      bind_rows(summarise_all(., ~(if(is.numeric(.)) sum(.) else "Total")))
    tmp
  })

}

shinyApp(ui, server)

Answer 1

I think the easiest way might be to change the renderTable() function to the following:

output$stratData <- renderTable({
    req(input$stratValues)
    req(input$stratPeriod)
    
    filter_exp1 <- parse(text=paste0("Period",  "==", "'",input$stratPeriod, "'"))
    
    dat_1 <- reactive({dat() %>% filter(eval(filter_exp1))})
    min <- custom_min(dat_1()[[input$stratValues]])
    max <- custom_max(dat_1()[[input$stratValues]])
    breaks <- if(any(is.infinite(c(min,max)))) c(0, 10) else seq(min, max, length.out = 6) 
    
    tmp <- dat() %>% 
      filter(eval(filter_exp1)) %>%
      mutate(Range = cut(!!sym(input$stratValues), breaks=breaks, include.lowest=TRUE, right = TRUE, dig.lab = 5)) %>% 
      group_by(Range) 
    if(input$stratValues == "Values_2"){
      tmp <- tmp %>% 
        filter(Flag == "N") 
    }
    tmp <- tmp %>% 
      summarise(Count = n(),Values = sum(!!sym(input$stratValues))) %>% 
      complete(Range, fill = list(Count = 0,Values = 0)) %>% 
      ungroup %>% 
      mutate(Count_pct = Count/sum(Count)*100, Values_pct = Values/sum(Values)*100) %>% 
      dplyr::select(everything(), Count, Count_pct, Values, Values_pct) %>%
      bind_rows(summarise_all(., ~(if(is.numeric(.)) sum(.) else "Total")))
    tmp
  })

In the code above, there is an if() condition that identifies whether stratValues is Values_2. If so, it filters the data to only include the "N" observations on Flag. Then, it continues with the rest of the analysis. This will work if both Values and Countare calculated only on the observations whereFlag == "N"`.