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