环境准备与包加载

required_pkgs <- c("netmeta", "dplyr", "tidyr", "openxlsx", "ggplot2")
new_pkgs <- required_pkgs[!required_pkgs %in% installed.packages()[, "Package"]]
if (length(new_pkgs) > 0) install.packages(new_pkgs)

library(netmeta)
## Loading required package: meta
## Loading required package: metadat
## Loading 'meta' package (version 7.0-0).
## Type 'help(meta)' for a brief overview.
## Readers of 'Meta-Analysis with R (Use R!)' should install
## older version of 'meta' package: https://tinyurl.com/dt4y5drs
## Loading 'netmeta' package (version 2.9-0).
## Type 'help("netmeta-package")' for a brief overview.
## Readers of 'Meta-Analysis with R (Use R!)' should install
## older version of 'netmeta' package: https://tinyurl.com/kyz6wjbb
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(tidyr)
library(openxlsx)
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.5.2

数据构建与清洗

模拟包含12个干预组、双结局(MMSE与MoCA)的多中心多臂临床试验数据。若使用本地数据,可替换为读取外部文件。

set.seed(123)

treatments_list <- c(
  "SOC", "EA-SOC", "BA-SOC", "ScA-SOC", "C-SOC", "N-SOC",
  "Placebo", "SA-C", "SA-SOC", "ScA-C-SOC", "BA-C", "EA-N-SOC"
)

raw_sim_data <- data.frame(
  Study = rep(paste0("Study_", 1:30), each = 2),
  Treatment = sample(treatments_list, 60, replace = TRUE),
  Number.of.patients = sample(35:120, 60, replace = TRUE),
  MMSE_Mean = round(rnorm(60, mean = 22.5, sd = 3.8), 2),
  MMSE_SD = round(runif(60, min = 1.5, max = 3.2), 2),
  MoCA_Mean = round(rnorm(60, mean = 19.2, sd = 4.5), 2),
  MoCA_SD = round(runif(60, min = 1.8, max = 3.8), 2)
)

# 确保每个研究至少包含2个不重复的有效治疗臂
data_total <- raw_sim_data %>%
  distinct(Study, Treatment, .keep_all = TRUE) %>%
  group_by(Study) %>%
  filter(n() >= 2) %>%
  ungroup()

head(data_total)
## # A tibble: 6 × 7
##   Study   Treatment Number.of.patients MMSE_Mean MMSE_SD MoCA_Mean MoCA_SD
##   <chr>   <chr>                  <int>     <dbl>   <dbl>     <dbl>   <dbl>
## 1 Study_2 ScA-C-SOC                106      22.8    2.89     18.3     2.69
## 2 Study_2 EA-SOC                   120      23.3    3.17     23.6     3.05
## 3 Study_3 N-SOC                    120      20.6    1.68     15.3     1.8 
## 4 Study_3 BA-C                      73      20.1    1.67     16.9     2.23
## 5 Study_4 C-SOC                     65      22.3    2.86     22.7     3.21
## 6 Study_4 ScA-SOC                  115      23.1    2.83      9.74    2.23

两两配对与模型拟合

# 结局1:MMSE
pw_mmse <- pairwise(
  treat = Treatment,
  mean = MMSE_Mean,
  sd = MMSE_SD,
  n = Number.of.patients,
  studlab = Study,
  data = data_total,
  sm = "MD"
)

# 结局2:MoCA
pw_moca <- pairwise(
  treat = Treatment,
  mean = MoCA_Mean,
  sd = MoCA_SD,
  n = Number.of.patients,
  studlab = Study,
  data = data_total,
  sm = "MD"
)

# 拟合随机效应模型,基准组设为SOC
net_mmse <- netmeta(
  pw_mmse,
  reference.group = "SOC",
  common = FALSE,
  random = TRUE
)

net_moca <- netmeta(
  pw_moca,
  reference.group = "SOC",
  common = FALSE,
  random = TRUE
)

绘制网状结构图

node_sizes <- sqrt(net_mmse$n.trts) / 2.2

par(mar = c(2, 2, 2, 2))
netgraph(
  net_mmse,
  plastic = FALSE,
  points = TRUE,
  col = "#681358",
  col.points = "#681358",
  col.multiarm = "#681358",
  cex.points = node_sizes,
  thickness = "number.of.studies",
  lwd.min = 1.5,
  lwd.max = 9,
  labels = net_mmse$trts,
  offset = 0.04,
  cex = 0.85
)

双结局联赛表矩阵生成与半区拆分

league_combined <- netleague(
  x = net_moca,
  y = net_mmse,
  digits = 2,
  bracket = "(",
  separator = ", "
)

league_matrix <- league_combined$random
n_dim <- nrow(league_matrix)
trts <- rownames(league_matrix)

# 上半三角矩阵(保留对角线与右上区)
upper_mat <- league_matrix
for (i in 1:n_dim) {
  for (j in 1:n_dim) {
    if (i > j) upper_mat[i, j] <- ""
  }
}

# 下半三角矩阵(保留对角线与左下区)
lower_mat <- league_matrix
for (i in 1:n_dim) {
  for (j in 1:n_dim) {
    if (i < j) lower_mat[i, j] <- ""
  }
}

阶梯式热图呈现

plot_df <- expand.grid(Row = 1:n_dim, Col = 1:n_dim)
plot_df$Trt_Row <- factor(trts[plot_df$Row], levels = rev(trts))
plot_df$Trt_Col <- factor(trts[plot_df$Col], levels = trts)
plot_df$Label <- as.vector(league_matrix)
plot_df$Type <- ifelse(plot_df$Row == plot_df$Col, "Diagonal",
                ifelse(plot_df$Row < plot_df$Col, "Upper", "Lower"))

# 仅绘制右上三角阶梯结构
upper_plot_df <- subset(plot_df, Row <= Col)

p_upper <- ggplot(upper_plot_df, aes(x = Trt_Col, y = Trt_Row)) +
  geom_tile(aes(fill = Type), color = "black", linewidth = 0.5) +
  geom_text(aes(label = Label, color = Type), size = 2.4, fontface = "bold") +
  scale_fill_manual(values = c("Diagonal" = "#681358", "Upper" = "#FFFFFF")) +
  scale_color_manual(values = c("Diagonal" = "#FFFFFF", "Upper" = "#000000")) +
  scale_x_discrete(position = "top") +
  labs(title = "MMSE (Upper Triangle)", x = "", y = "") +
  theme_minimal() +
  theme(
    axis.text.x.top = element_text(angle = 45, hjust = 0, vjust = 0, face = "bold", size = 9),
    axis.text.y = element_text(face = "bold", size = 9),
    panel.grid = element_blank(),
    legend.position = "none"
  )

p_upper

导出格式化 Excel 表格

wb <- createWorkbook()

diagonal_style <- createStyle(
  fgFill = "#681358",
  fontColour = "#FFFFFF",
  textDecoration = "bold",
  halign = "center",
  valign = "center",
  fontSize = 9,
  wrapText = TRUE
)

cell_border_style <- createStyle(
  halign = "center",
  valign = "center",
  fontSize = 8.5,
  border = "TopBottomLeftRight",
  borderColour = "#000000",
  wrapText = TRUE
)

title_style <- createStyle(
  halign = "center",
  valign = "center",
  fontSize = 12,
  textDecoration = "bold"
)

export_staircase <- function(wb, sheet_name, mat, mode = c("upper", "lower"), outcome_label = "") {
  addWorksheet(wb, sheet_name)
  
  writeData(wb, sheet = sheet_name, x = outcome_label, startRow = 1, startCol = 2)
  mergeCells(wb, sheet = sheet_name, cols = 2:(n_dim + 1), rows = 1)
  addStyle(wb, sheet = sheet_name, style = title_style, rows = 1, cols = 2)
  
  writeData(wb, sheet = sheet_name, x = mat, rowNames = FALSE, colNames = FALSE, startRow = 2, startCol = 2)
  
  for (i in 1:n_dim) {
    for (j in 1:n_dim) {
      curr_r <- i + 1
      curr_c <- j + 1
      
      if (i == j) {
        addStyle(wb, sheet = sheet_name, style = diagonal_style, rows = curr_r, cols = curr_c)
      } else if (mode == "upper" && i < j) {
        addStyle(wb, sheet = sheet_name, style = cell_border_style, rows = curr_r, cols = curr_c)
      } else if (mode == "lower" && i > j) {
        addStyle(wb, sheet = sheet_name, style = cell_border_style, rows = curr_r, cols = curr_c)
      }
    }
  }
  
  setColWidths(wb, sheet = sheet_name, cols = 2:(n_dim + 1), widths = 16)
  setRowHeights(wb, sheet = sheet_name, rows = 2:(n_dim + 1), heights = 28)
}

export_staircase(wb, "Upper_Triangle_MMSE", upper_mat, mode = "upper", outcome_label = "MMSE")
export_staircase(wb, "Lower_Triangle_MoCA", lower_mat, mode = "lower", outcome_label = "MoCA")

saveWorkbook(wb, "Dual_Outcome_Staircase_Table.xlsx", overwrite = TRUE)