如何在R Shiny中创建支持多行列钻取的类Excel数据透视表？

以下是一个可直接运行的示例，基于mtcars数据集实现支持任意行/列维度钻取的数据透视表，核心通过跟踪钻取状态、响应单元格点击事件来动态更新汇总层级：

完整代码 #

library(shiny)
library(DT)
library(dplyr)
library(tidyr)

ui <- fluidPage(
  titlePanel("多行多列可钻取数据透视表"),
  DTOutput("pivot_table")
)

server <- function(input, output, session) {
  # 初始化钻取状态：记录当前行维度、列维度、已钻取的层级
  drill_state <- reactiveValues(
    row_dims = c("cyl", "gear"),
    col_dims = c("am", "carb"),
    agg_level = list(row = 1, col = 1)
  )
  
  # 生成当前层级的汇总数据
  current_data <- reactive({
    row_dims <- drill_state$row_dims[1:drill_state$agg_level$row]
    col_dims <- drill_state$col_dims[1:drill_state$agg_level$col]
    
    mtcars %>%
      mutate(across(c(row_dims, col_dims), as.factor)) %>%
      group_by(across(c(row_dims, col_dims))) %>%
      summarise(
        mean_mpg = mean(mpg),
        count = n(),
        .groups = "drop"
      ) %>%
      pivot_wider(
        names_from = all_of(col_dims),
        values_from = c(mean_mpg, count),
        names_sep = "_"
      )
  })
  
  # 渲染数据透视表
  output$pivot_table <- renderDT({
    datatable(
      current_data(),
      selection = "single",
      rownames = FALSE,
      options = list(
        dom = "t",
        ordering = FALSE
      ),
      callback = JS(
        "table.on('click', 'td', function() {
          var cell = table.cell(this);
          var rowIdx = cell.index().row;
          var colIdx = cell.index().column;
          Shiny.setInputValue('cell_click', {row: rowIdx, col: colIdx});
        });"
      )
    )
  })
  
  # 处理单元格点击事件，更新钻取状态
  observeEvent(input$cell_click, {
    clicked_col <- colnames(current_data())[input$cell_click$col]
    # 判断点击的是行维度列还是数值列
    if (clicked_col %in% drill_state$row_dims[1:drill_state$agg_level$row]) {
      # 行维度钻取：如果还有下一层级则展开
      if (drill_state$agg_level$row < length(drill_state$row_dims)) {
        drill_state$agg_level$row <- drill_state$agg_level$row + 1
      }
    } else {
      # 列维度钻取：解析列名中的维度，判断是否可展开
      col_dim <- strsplit(clicked_col, "_")[[1]][2]
      if (col_dim %in% drill_state$col_dims[1:drill_state$agg_level$col]) {
        if (drill_state$agg_level$col < length(drill_state$col_dims)) {
          drill_state$agg_level$col <- drill_state$agg_level$col + 1
        }
      }
    }
  })
}

shinyApp(ui, server)

关键实现说明 #

• 钻取状态管理：用reactiveValues存储当前行/列维度的展开层级，可通过修改row_dims和col_dims设置自定义钻取维度。
• 动态数据汇总：根据当前钻取层级，用dplyr分组聚合数据，再通过pivot_wider转换为透视表格式，支持自定义聚合指标。
• 单元格点击响应：通过DT的JS回调监听点击事件，判断点击区域对应的维度类型，自动更新钻取层级展开下一级数据。
• 灵活扩展：可调整summarise中的统计项、修改维度列表，适配不同业务场景的透视需求。

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