Why does this dplyr() grouping code work in base R but not when running in Shiny?-CodePudding

In base R, the following dplyr() code works as intended for the given data frame:

mydat <-
    data.frame(
      ID = c(115,115,115,88,88,88,100,100,100),
      Period_1 = c("2020-01", "2020-02", "2020-03", "2020-01", "2020-02", "2020-03", "2021-01","2021-02","2012-03"),
      Period_2 = c(1, 2, 3, 1, 2, 3, 1, 2, 3)
    )
 
  count_rows <-  
    mydat %>%
      dplyr::filter(Period_2 == 1) %>%
      dplyr::group_by(Period_1) %>%
      dplyr::summarise(Count = length(unique(ID)))
  
  timeView <- mydat %>%
    dplyr::summarise(Period_1 = unique(Period_1))
  
  count_rows <- timeView %>%
    dplyr::left_join(count_rows) %>%
    dplyr::mutate_if(is.numeric,coalesce,0)
  
  count_rows

Giving correct results for the count_rows object shown below when using Period_1 for grouping in the above code:

> count_rows
  Period_1 Count
1  2020-01     2
2  2020-02     0
3  2020-03     0
4  2021-01     1
5  2021-02     0
6  2012-03     0

And giving these correct results for the count_rows object when using Period_2 for grouping in the above code:

> count_rows
  Period_2 Count
1        1     3
2        2     0
3        3     0

Yet when I pull the very same code into Shiny, it crashes. I have commented-out the offending code so the below Shiny MWE example runs (incompletely though). Un-comment it and the App crashes. This code is meant to show the event counts ("event" defined as Period_2 = 1) along all periods in the data using a left_join function. With this offending code commented out, it only shows event counts for the periods in which the events occur. What am I doing wrong?

MWE code:

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

ui <-
  fluidPage(
    fluidRow(
      column(width = 8,
             h3("Data table:"),
             tableOutput("data"),
             h3("Count the data table rows:"),
             radioButtons(
               inputId = "grouping",
               label = NULL,
               choiceNames = c("By period 1", "By period 2"),
               choiceValues = c("Period_1", "Period_2"),
               selected = "Period_1",
               inline = TRUE
             ),
             DT::dataTableOutput("counts")
      )
    )
  )

server <- function(input, output, session) {
  mydat <- reactive({
    data.frame(
      ID = c(115,115,115,88,88,88,100,100,100),
      Period_1 = c("2020-01", "2020-02", "2020-03", "2020-01", "2020-02", "2020-03", "2021-01","2021-02","2012-03"),
      Period_2 = c(1, 2, 3, 1, 2, 3, 1, 2, 3)
      )
  })
  
  count_rows <- reactive({
    print(input$grouping)
    mydat() %>%
      dplyr::filter(Period_2 == 1) %>%
      dplyr::group_by(!!sym(input$grouping)) %>%
      dplyr::summarise(Count = length(unique(ID)))
    
    # timeView <- mydat() %>%
    #   dplyr::summarise(!!sym(input$grouping) == unique(!!sym(input$grouping)))
    # 
    # count_rows <- timeView %>%
    #   dplyr::left_join(count_rows) %>%
    #   dplyr::mutate_if(is.numeric,coalesce,0)
    
  })
 
  output$data <- renderTable(mydat())
  
  output$counts <- renderDT({
    count_rows() %>% 
      datatable(
        rownames = FALSE,
        )
  })
  
}

shinyApp(ui, server)

CodePudding user response：

Before the left_join, the column should be assigned (:=) instead of ==

count_rows <- reactive({
    
    tmp <- mydat() %>%
      dplyr::filter(Period_2 == 1) %>%
      dplyr::group_by(!!sym(input$grouping)) %>%
      dplyr::summarise(Count = length(unique(ID)))
    
     timeView <- mydat() %>%
       dplyr::summarise(!!input$grouping := unique(!!sym(input$grouping)))
     
     timeView %>%
       dplyr::left_join(tmp) %>%
       dplyr::mutate_if(is.numeric,coalesce,0)
    
  })

-server code

server <- function(input, output, session) {
  mydat <- reactive({
    data.frame(
      ID = c(115,115,115,88,88,88,100,100,100),
      Period_1 = c("2020-01", "2020-02", "2020-03", "2020-01", "2020-02", "2020-03", "2021-01","2021-02","2012-03"),
      Period_2 = c(1, 2, 3, 1, 2, 3, 1, 2, 3)
    )
  })
  
  count_rows <- reactive({
    
    tmp <- mydat() %>%
      dplyr::filter(Period_2 == 1) %>%
      dplyr::group_by(!!sym(input$grouping)) %>%
      dplyr::summarise(Count = length(unique(ID)))
    
     timeView <- mydat() %>%
       dplyr::summarise(!!input$grouping := unique(!!sym(input$grouping)))
     
     timeView %>%
       dplyr::left_join(tmp) %>%
       dplyr::mutate_if(is.numeric,coalesce,0)
    
  })
  
  output$data <- renderTable(mydat())
  
  output$counts <- renderDT({
    count_rows() %>% 
      datatable(
        rownames = FALSE,
      )
  })
  
}

-testing

shinyApp(ui, server)

-output