r - 为什么此 dplyr() 分组代码在 base R 中有效，但在 Shiny 中运行时却无效？

Question

在 base R 中，以下 dplyr() 代码按预期用于给定数据帧:

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

在上述代码中使用 Period_1 进行分组时，为下面显示的 count_rows 对象提供正确的结果:

> 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

在上述代码中使用 Period_2 进行分组时，为 count_rows 对象提供这些正确结果:

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

然而，当我将完全相同的代码拉入 Shiny 时，它崩溃了。我已经注释掉了有问题的代码，所以下面的 Shiny MWE 示例运行了(虽然不完整)。取消注释，应用程序崩溃。此代码旨在使用 left_join 函数显示数据中沿所有 周期的事件计数(“事件”定义为 Period_2 = 1)。注释掉这个有问题的代码后，它只显示事件发生期间的事件计数。我做错了什么？

MWE代码:

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)

Answer 1

在left_join之前，列应该被赋值(:=)而不是==

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 <- 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,
      )
  })
  
}

-测试

shinyApp(ui, server)

-输出