在R中创建嵌套多层可展开行的DT表格：年-月-周聚合数据展示

我们只需要对原代码做两处核心调整即可实现需求：R端补全嵌套的周维度汇总数据结构，JS端新增月度行的展开控制逻辑。以下是完整可运行的修改后代码：

library(shiny)
library(DT)
library(jsonlite)
library(lubridate)
library(tidyverse)

# 构造原始数据
so_date<- seq(as.Date("2019-07-01"),as.Date("2021-08-22"), by = "day")
pivot_df<-cbind.data.frame(Date = so_date,
                           Year = year(so_date),
                           Month = months(so_date),
                           Week = lubridate::week(so_date),
                           TI = sample.int(1000, 784, replace = TRUE),
                           PAU = sample.int(1000, 784, replace = TRUE),
                           AU = sample.int(1000, 784, replace = TRUE),
                           PE = sample.int(1000, 784, replace = TRUE),
                           TPH = sample.int(1000, 784, replace = TRUE),
                           APD = sample.int(1000, 784, replace = TRUE),
                           PRC = sample.int(1000, 784, replace = TRUE),
                           URC = sample.int(1000, 784, replace = TRUE),
                           Pat_AU = sample.int(1000, 784, replace = TRUE))

server <- function(input, output) {
  # 按年拆分数据
  l.df<- split(pivot_df,pivot_df$Year)
  
  l.cars <- lapply(l.df, function(year_data) {
    # 生成月度汇总，同时嵌套周维度汇总
    subTable1 <- year_data %>% 
      group_by(Month) %>% 
      group_modify(~{
        # 计算当前月的周汇总
        week_sum <- .x %>% 
          group_by(Week) %>% 
          summarize(TI = sum(TI, na.rm = T),
                    AU = sum(AU, na.rm = T),
                    PAU = sum(PAU, na.rm = T),
                    PE  = sum(PE , na.rm = T),
                    TPH = sum(TPH, na.rm = T),
                    APD  = sum(APD , na.rm = T),
                    PRC = sum(PRC, na.rm = T),
                    URC = sum(URC, na.rm = T))
        # 计算当前月的汇总值
        month_sum <- .x %>% 
          summarize(TI = sum(TI, na.rm = T),
                    AU = sum(AU, na.rm = T),
                    PAU = sum(PAU, na.rm = T),
                    PE  = sum(PE , na.rm = T),
                    TPH = sum(TPH, na.rm = T),
                    APD  = sum(APD , na.rm = T),
                    PRC = sum(PRC, na.rm = T),
                    URC = sum(URC, na.rm = T))
        # 把周汇总序列化后加入月度行
        month_sum$week_subTable = toJSON(week_sum)
        return(month_sum)
      }) %>% 
      ungroup()
    
    # 计算年度汇总值
    year_sum <- year_data %>% 
      summarize(TI = sum(TI, na.rm = T),
                AU = sum(AU, na.rm = T),
                PAU = sum(PAU, na.rm = T),
                PE  = sum(PE , na.rm = T),
                TPH = sum(TPH, na.rm = T),
                APD  = sum(APD , na.rm = T),
                PRC = sum(PRC, na.rm = T),
                URC = sum(URC, na.rm = T))
    
    return(list(
      TI = year_sum$TI,
      AU = year_sum$AU,
      PAU = year_sum$PAU,
      PE  = year_sum$PE,
      TPH = year_sum$TPH,
      APD  = year_sum$APD,
      PRC = year_sum$PRC,
      URC = year_sum$URC,
      subTable = toJSON(subTable1)
    ))
  })
  
  df<- data.frame(Year = names(l.cars), do.call('rbind', l.cars), stringsAsFactors = FALSE)
  
  output$dt <- DT::renderDataTable({
    df <- cbind(' ' = '&oplus;', df)
    datatable(
      df, 
      escape = -2,
      options = list(
        dom = 't',
        columnDefs = list(
          list(visible = FALSE, targets = c(0, 11)),
          list(orderable = FALSE, className = 'details-control', targets = 1)
        )
      ),
      
      callback = JS("
          // 格式化周维度子表
          var formatWeek = function(weekData) {
            var table = document.createElement('table');
            table.style.marginLeft = '20px';
            var tableBody = document.createElement('tbody');
            
            // 生成表头
            var headers = [];
            $.each(weekData[0], function(k, v) {
              if(k != 'week_subTable') headers.push(k);
            })
            var headerRow = document.createElement('tr');
            for(var i=0; i<headers.length; i++){
              var th = document.createElement('th');
              th.appendChild(document.createTextNode(headers[i]));
              th.style.backgroundColor = 'lightyellow';
              headerRow.appendChild(th);
            }
            table.appendChild(headerRow);
            
            // 生成表体
            $.each(weekData, function(index, item) {
              var row = document.createElement('tr');
              $.each(item, function(k, v) {
                if(k != 'week_subTable') {
                  var cell = document.createElement('td');
                  cell.appendChild(document.createTextNode(v));
                  cell.style.backgroundColor = 'lightyellow';
                  row.appendChild(cell);
                }
              })
              tableBody.appendChild(row);
            })
            table.appendChild(tableBody);
            return table;
          }
          
          // 格式化月度子表
          var format = function(d) {
            var table = document.createElement('table');
            var tableBody = document.createElement('tbody');
            var embeddedTableRows = d[11];
            
            // 生成表头
            var headers = [];
            $.each(embeddedTableRows[0], function(k, v) {
              if(k != 'week_subTable') headers.push(k);
            })
            // 多留一列放展开按钮
            var headerRow = document.createElement('tr');
            var emptyTh = document.createElement('th');
            headerRow.appendChild(emptyTh);
            for(var i=0; i<headers.length; i++){
              var th = document.createElement('th');
              th.appendChild(document.createTextNode(headers[i]));
              th.style.backgroundColor = 'lightblue';
              headerRow.appendChild(th);
            }
            table.appendChild(headerRow);
            
            // 生成表体
            for (var i = 0; i < embeddedTableRows.length; i++) {
              var monthItem = embeddedTableRows[i];
              var row = document.createElement('tr');
              
              // 加展开按钮
              var ctrlCell = document.createElement('td');
              ctrlCell.innerHTML = '&oplus;';
              ctrlCell.style.color = 'green';
              ctrlCell.style.fontWeight = 'bold';
              ctrlCell.style.fontSize = '150%';
              ctrlCell.style.cursor = 'pointer';
              ctrlCell.className = 'month-details-control';
              ctrlCell.dataset.weekdata = JSON.stringify(monthItem.week_subTable);
              row.appendChild(ctrlCell);
              
              // 加月度数据列
              $.each(monthItem, function(k, v) {
                if(k != 'week_subTable') {
                  var cell = document.createElement('td');
                  cell.appendChild(document.createTextNode(v));
                  cell.style.backgroundColor = 'lightblue';
                  row.appendChild(cell);
                }
              })
              tableBody.appendChild(row);
            }
            table.appendChild(tableBody);
            return(table);
          };
          
          // 年度行展开事件
          table.on('click', 'td.details-control', function() {
            var td = $(this), row = table.row(td.closest('tr'));
            if (row.child.isShown()) {
              row.child.hide();
              td.html('&oplus;').css('color', 'green');
            } else {
              row.child(format(row.data())).show();
              td.html('&CircleMinus;').css('color', 'red');
            }
          });
          
          // 月度行展开事件
          $(document).on('click', 'td.month-details-control', function() {
            var td = $(this);
            var weekData = JSON.parse(td.data('weekdata'));
            var tr = td.closest('tr');
            var nextTr = tr.next();
            if(nextTr.hasClass('week-row')) {
              nextTr.remove();
              td.html('&oplus;').css('color', 'green');
            } else {
              var weekRow = document.createElement('tr');
              weekRow.className = 'week-row';
              var cell = document.createElement('td');
              cell.colSpan = tr.children().length;
              cell.appendChild(formatWeek(weekData));
              weekRow.appendChild(cell);
              tr.after(weekRow);
              td.html('&CircleMinus;').css('color', 'red');
            }
          });"
      ),
      selection = 'none') %>% 
      formatStyle(1,  color = 'green', fontWeight = 'bold', fontSize = '150%', cursor = 'pointer')
  })
}

ui <- fluidPage(
  br(),
  h4('三层可展开DT表示例（年→月→周）'),
  br(),
  DT::dataTableOutput('dt')
)

shinyApp(server = server, ui = ui)

核心修改说明 #

• R端数据处理：在月度汇总逻辑中新增了每个月对应的周维度汇总，序列化后作为week_subTable字段存入月度行数据，保证嵌套层级完整
• JS端逻辑：
  1. 新增formatWeek函数用于渲染周维度子表，用浅黄色做层级区分
  2. 修改月度表渲染逻辑，给每个月度行第一列增加展开控制按钮
  3. 新增月度行点击事件监听，点击时渲染对应周维度子表插入到月度行下方

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