R语言抑郁症状网络分析

大家好，我是带我去滑雪！

桥接网络分析是一种用于识别不同群体（或社区）间关键连接关系的网络分析方法。在心理与精神健康研究中，该方法常被用于定位那些连接不同症状群的核心症状，这些症状通常被视为干预的潜在靶点。例如，若将抑郁症状划分为"情感""认知"与"躯体"三类，桥接分析即可量化各症状的"跨组连接"强度，从而识别出在症状网络中可能起枢纽作用的桥梁症状。

为进行实证分析，采用R语言内置的depression数据集，该数据集收录了1000名抑郁患者在9个核心症状（如悲伤、快感缺失、注意力问题等）上的连续评分。

R语言完整代码实现：

# 加载必要的包
install.packages("networktools")
install.packages("qgraph")
install.packages("bootnet")
install.packages("ggplot2")
install.packages("dplyr")
install.packages("tidyr")


# 加载必要的包
library(networktools)
library(qgraph)
library(bootnet)
library(ggplot2)
library(dplyr)
library(tidyr)

# 加载数据
data("depression")

# 查看数据结构
str(depression)
head(depression)

# 定义症状分组
symptom_groups <- list(
  emotional_symptoms = c("sadness", "anhedonia", "worthlessness"),
  physical_symptoms = c("weight_change", "sleep_disturbance", 
                        "psychomotor_retardation", "fatigue"),
  cognitive_symptoms = c("concentration_problems", "suicidal_ideation")
)


# 创建分组向量
group_vector <- rep(names(symptom_groups), 
                    sapply(symptom_groups, length))
names(group_vector) <- unlist(symptom_groups)

# 确保数据列顺序与分组向量一致
depression <- depression[, names(group_vector)]


# 方法1: 使用GGM估计网络并进行桥接分析
##########################################

# 估计高斯图形模型(GGM)网络 - 适用于连续数据
network_model <- estimateNetwork(
  depression,
  default = "EBICglasso",
  corMethod = "cor_auto",  # 自动检测数据类型
  tuning = 0.5,
  threshold = TRUE  # 使用阈值处理，提高特异性
)

# 获取网络矩阵
network_matrix <- network_model$graph 

# 定义组颜色
group_colors <- c("#FF6B6B", "#4ECDC4", "#45B7D1")

# 创建节点颜色向量，按照数据列的顺序
vertex_colors <- rep(NA, ncol(depression))
for(i in 1:length(symptom_groups)){
  group_symptoms <- symptom_groups[[i]]
  vertex_colors[colnames(depression) %in% group_symptoms] <- group_colors[i]
}


# 绘制网络图，不使用groups参数，使用vertex.color
network_plot <- qgraph(
  network_matrix,
  layout = "spring",
  color = vertex_colors,
  nodeNames = colnames(depression),
  legend = FALSE,  # 先关闭自动图例
  vsize = 8,
  label.cex = 1.2,
  title = "抑郁症状网络 (GGM估计)",
  edge.width = 1.5
)

print(network_plot)

# 计算中心性指标
centrality_measures <- centrality_auto(network_matrix)
print(centrality_measures$node.centrality)

# 可视化中心性
centrality_plot <- centralityPlot(
  network_matrix,
  include = c("Strength", "Betweenness", "Closeness"),
  orderBy = "Strength"
) + ggtitle("症状中心性指标")

print(centrality_plot)

# 方法2: 进行桥接分析
########################################

# 使用bridge()函数进行桥接分析
bridge_result <- bridge(
  network_matrix, 
  communities = group_vector[colnames(depression)]
)

# 提取桥接强度
bridge_strength <- bridge_result$`Bridge Strength`

# 提取桥接预期影响（1步和2步）
bridge_expected_influence_1step <- bridge_result$`Bridge Expected Influence (1-step)`
bridge_expected_influence_2step <- bridge_result$`Bridge Expected Influence (2-step)`

# 然后，在创建bridge_results数据框时，使用这些变量
bridge_results <- data.frame(
  Symptom = colnames(depression),
  Group = group_vector[colnames(depression)],
  Bridge_Strength = bridge_strength,
  Bridge_EI_1step = bridge_expected_influence_1step,
  Bridge_EI_2step = bridge_expected_influence_2step,
  stringsAsFactors = FALSE
)

# 按桥接强度排序
bridge_results <- bridge_results[order(-bridge_results$Bridge_Strength), ]

print("桥接分析结果:")
print(bridge_results)

# 可视化桥接强度
bridge_plot <- ggplot(bridge_results, 
                      aes(x = reorder(Symptom, Bridge_Strength), 
                          y = Bridge_Strength, fill = Group)) +
  geom_bar(stat = "identity", width = 0.7) +
  coord_flip() +
  theme_minimal() +
  labs(title = "抑郁症状的桥接强度",
       x = "症状", y = "桥接强度") +
  scale_fill_manual(values = c("emotional_symptoms" = "#FF6B6B",
                               "physical_symptoms" = "#4ECDC4",
                               "cognitive_symptoms" = "#45B7D1")) +
  theme(plot.title = element_text(hjust = 0.5, face = "bold"),
        axis.text = element_text(size = 10))

print(bridge_plot)

# 分析组间连接模式
##########################################

# 提取邻接矩阵
adj_matrix <- network_matrix

# 计算组内和组间连接
connection_analysis <- data.frame()

for (from_group in names(symptom_groups)) {
  for (to_group in names(symptom_groups)) {
    from_symptoms <- symptom_groups[[from_group]]
    to_symptoms <- symptom_groups[[to_group]]
    
    # 提取子矩阵
    sub_matrix <- adj_matrix[from_symptoms, to_symptoms, drop = FALSE]
    
    # 如果是同一组，排除对角线
    if (from_group == to_group) {
      diag(sub_matrix) <- 0
    }
    
    # 计算连接统计
    avg_connection <- mean(abs(sub_matrix))
    sum_connection <- sum(abs(sub_matrix))
    n_connections <- length(sub_matrix)
    
    connection_analysis <- rbind(connection_analysis, data.frame(
      From_Group = from_group,
      To_Group = to_group,
      Avg_Connection = avg_connection,
      Sum_Connection = sum_connection,
      N_Connections = ifelse(from_group == to_group, 
                             length(from_symptoms) * (length(to_symptoms) - 1),
                             length(from_symptoms) * length(to_symptoms))
    ))
  }
}

print("组间连接分析:")
print(connection_analysis)

# 可视化组间连接热图
heatmap_plot <- ggplot(connection_analysis, 
                       aes(x = From_Group, y = To_Group, fill = Avg_Connection)) +
  geom_tile(color = "white", linewidth = 1) +  # 将size改为linewidth
  geom_text(aes(label = round(Avg_Connection, 3)), color = "white", size = 5, fontface = "bold") +
  scale_fill_gradient(low = "#E3F2FD", high = "#1565C0", 
                      name = "平均连接强度") +
  theme_minimal() +
  theme(axis.text = element_text(size = 11),
        axis.title = element_text(size = 12, face = "bold"),
        plot.title = element_text(hjust = 0.5, size = 14, face = "bold")) +
  labs(title = "症状组间平均连接强度",
       x = "来源组", y = "目标组") +
  coord_fixed()

print(heatmap_plot)

# 识别最重要的桥梁症状
##########################################

# 找出前3个桥梁症状
top_bridge_symptoms <- bridge_results[1:3, ]

print("最重要的桥梁症状:")
print(top_bridge_symptoms)

# 分析这些症状的连接模式
cat("\n=== 桥梁症状详细分析 ===\n")
for (i in 1:nrow(top_bridge_symptoms)) {
  symptom <- top_bridge_symptoms$Symptom[i]
  group <- top_bridge_symptoms$Group[i]
  
  # 获取该症状的连接
  connections <- adj_matrix[symptom, ]
  connections <- connections[names(connections) != symptom]  # 排除自连接
  
  # 按组统计连接强度
  group_connections <- data.frame(
    Symptom = names(connections),
    Strength = connections,
    Group = group_vector[names(connections)]
  ) %>%
    group_by(Group) %>%
    summarise(
      Avg_Strength = mean(abs(Strength)),
      Max_Strength = max(abs(Strength))
    )
  
  cat(sprintf("\n%s (%s组)的连接模式:\n", symptom, group))
  print(group_connections)
}

# 网络稳定性分析
##########################################

# 使用bootstrap评估网络稳定性
set.seed(123)  # 设置随机种子以便结果可重复
boot_results <- bootnet(
  depression,
  nBoots = 500,  # 减少bootstrap次数以加快计算速度
  default = "EBICglasso",
  type = "nonparametric",
  statistics = c("edge", "strength", "bridgeStrength"),
  communities = group_vector[colnames(depression)],
  nCores = 4
)

# 绘制边权重的bootstrap结果
plot(boot_results, statistics = "edge", order = "sample")

# 绘制强度稳定性的bootstrap结果
plot(boot_results, statistics = "strength")


# ============ 新增：为CS系数创建person类型的bootstrap ============
# 运行person类型的bootstrap用于计算CS系数
set.seed(123)
boot_results_person <- bootnet(
  depression,
  nBoots = 250,  # 可以减少次数，因为person类型计算较慢
  default = "EBICglasso",
  type = "person",  # 必须使用"person"或"node"类型
  statistics = c("bridgeStrength", "bridgeExpectedInfluence"),
  communities = group_vector[colnames(depression)],
  nCores = 4
)

# 计算CS系数（相关性稳定性系数）
cs_bridge_strength <- corStability(
  boot_results_person, 
  statistics = "bridgeStrength"
)

# 计算桥接预期影响的CS系数（如果需要的话）
cs_bridge_EI <- corStability(
  boot_results_person, 
  statistics = "bridgeExpectedInfluence"
)

# 打印CS系数
cat("\n=== 桥接中心性稳定性系数（CS系数） ===\n")
cat(sprintf("桥接强度 CS系数: %.3f\n", cs_bridge_strength))
if(exists("cs_bridge_EI")) {
  cat(sprintf("桥接预期影响 CS系数: %.3f\n", cs_bridge_EI))
}



# 保存重要结果
##########################################

save_path <- "D:/分析结果/"

# 保存桥接分析结果
write.csv(bridge_results, paste0(save_path, "bridge_analysis_results.csv"), row.names = FALSE)

# 保存组间连接分析结果
write.csv(connection_analysis, paste0(save_path, "group_connection_analysis.csv"), row.names = FALSE)

# 保存网络矩阵
write.csv(adj_matrix, paste0(save_path, "network_adjacency_matrix.csv"))

# 创建分析报告
analysis_report <- list(
  Network_Properties = list(
    Density = mean(abs(adj_matrix[lower.tri(adj_matrix)])),
    N_Nodes = ncol(adj_matrix),
    N_Edges = sum(abs(adj_matrix[lower.tri(adj_matrix)]) > 0)
  ),
  Top_Bridge_Symptoms = top_bridge_symptoms,
  Strongest_Group_Connection = connection_analysis[which.max(connection_analysis$Avg_Connection), ],
  Bridge_Strength_Summary = summary(bridge_results$Bridge_Strength)
)

cat("\n=== 分析报告 ===\n")
print(analysis_report)

# 保存图表
ggsave(paste0(save_path, "bridge_strength_plot.png"), bridge_plot, width = 10, height = 6, dpi = 300)
ggsave(paste0(save_path, "group_connection_heatmap.png"), heatmap_plot, width = 8, height = 6, dpi = 300)

# 创建组合图
par(mfrow = c(2, 2))
plot(network_plot)
plot(centrality_plot)
plot(bridge_plot)
plot(heatmap_plot)

结果展示：

通过桥接网络分析识别出三个关键的"桥梁症状"：快感缺失（桥接强度2.46）、注意力问题（桥接强度2.24）和疲劳（桥接强度2.02）。这些症状在抑郁的情感、认知与躯体症状群之间发挥着关键的连接作用。

进一步分析显示，情感与认知症状组间的连接最为紧密（平均强度0.342），其次为躯体-情感症状组（0.313），而躯体-认知症状组间的连接相对较弱（0.261）。网络的稳定性检验（CS系数=0.75）表明上述发现具有较好的可重复性，主要桥梁症状在不同样本中保持稳定。

---

更多优质内容持续发布中，请移步主页查看。

若有问题可邮箱联系：1736732074@qq.com

博主的WeChat:ZSYFKJ0001

点赞+关注,下次不迷路！