从Shiny Module读取Reactive Elements生成图表时数据不更新问题

你传递给Shiny模块的是静态计算结果而非响应式表达式，导致输入控件值变更后无法触发图表重渲染：

1. 原代码直接调用employement_type_count()后将结果传入模块，该结果仅在应用启动时计算一次，不会随input$employee_type变更更新
2. 即便将处理逻辑包进reactive()，若模块内部使用时未加()执行响应式表达式，也无法拿到最新数据

• 主服务端将数据处理逻辑封装为响应式表达式，将表达式对象传入模块而非静态结果
• 模块内部使用响应式数据时添加()执行，获取最新计算值
• 调整模块参数默认值逻辑，适配响应式数据传入场景

library(shiny)
library(shinyWidgets)
library(highcharter)
library(data.table)
library(dplyr)

employement_type_count <- function(
  data,
  category,
  ...
){
  data[employee_category %in% category, .(count = .N), by = employee_category]
}

pie_chart_ui <- function(id) {
  ns <- NS(id)
  highchartOutput(ns("pie"))
}

pie_chart_server <- function(
  id, 
  data, # 接收响应式表达式对象
  var_x = NULL, 
  var_y = NULL, 
  lab_x = NULL, 
  lab_y = NULL, 
  tooltip_name = NULL,
  export_title = NA
) {
  moduleServer(
    id,
    function(input, output, session) {
      output$pie <- renderHighchart({
        # 执行响应式表达式拿到最新数据
        current_data <- data()
        # 补全默认参数
        var_x <- if(is.null(var_x)) names(current_data)[1] else var_x
        var_y <- if(is.null(var_y)) names(current_data)[2] else var_y
        lab_x <- if(is.null(lab_x)) names(current_data)[1] else lab_x
        lab_y <- if(is.null(lab_y)) names(current_data)[2] else lab_y
        tooltip_name <- if(is.null(tooltip_name)) names(current_data)[2] else tooltip_name
        
        current_data %>%
          hchart(
            'pie', 
            hcaes_(x = var_x, y = var_y), 
            name = tooltip_name
          ) %>% 
          hc_xAxis(title = list(text = lab_x)) %>% 
          hc_yAxis(title = list(text = lab_y)) %>% 
          hc_plotOptions(
            pie = list(
              allowPointSelect = TRUE,
              cursor = 'pointer',
              dataLabels = list(
                enabled = TRUE,
                format = '<b>{point.name}</b>: {point.percentage:.1f}%',
                style = list(
                  color = "(Highcharts.theme && Highcharts.theme.contrastTextColor) || 'black'"
                )
              )
            )
          ) %>% 
          hc_exporting(
            enabled = TRUE,
            buttons = list(
              contextButton = list(
                align = 'right'
              )
            ),
            chartOptions = list(
              title = list(
                text = export_title
              )
            )
          )
      })
      
    }
  )    
}

ui <- fluidPage(
  sidebarPanel(
    pickerInput(
      "employee_type",
      "Employee Type",
      choices = c("Regular", "Project", "Service", "Part-Time"),
      selected = c("Regular", "Project", "Service", "Part-Time"),
      multiple = TRUE
    )
  ),
  mainPanel(
    pie_chart_ui("employee_category")
  )
)

server <- function(input, output, session){
  
  # 数据放在服务端，支持后续动态更新，比如定时读取csv
  data_common <- data.table(
    id = 1:26,
    employee_name = LETTERS,
    gender_type = rep(c("Male", "Female"), each = 13),
    employee_category = c("Regular", "Project", rep(c("Regular", "Project", "Service", "Part-Time"), times = 6))
  )
  
  # 封装为响应式表达式，input变更时自动重新计算
  processed_employee_data <- reactive({
    # 如果需要每次更新都读最新的csv，把fread放在这里即可
    # data_common <- fread("data_common.csv")
    employement_type_count(data_common, input$employee_type)
  })
  
  # 传入响应式表达式对象，不要加()
  pie_chart_server(
    "employee_category", 
    data = processed_employee_data
  )
  
}

shinyApp(ui, server)

内容的提问来源于stack exchange，提问作者Saikat Mitra