cellchat

https://www.nature.com/articles/s41467-023-36983-2#data-availability

01.全部代码

复制代码

options(stringsAsFactors = F)

library(ggplot2)
library(Seurat)
library(CellChat)
library(patchwork)
library(reshape2)
library(cowplot)
library(pheatmap)
library(viridis)

# 1. 加载数据并标准化
WAT.s.sub <- readRDS("WAT_scRNA_MTX_sc_20220921.RDS")
WAT.s.sub <- NormalizeData(WAT.s.sub)

# 2. 创建 CellChat 对象
cellchat.sc <- createCellChat(object = WAT.s.sub,assay = "RNA")

# 3. 设置参考数据库 (这里使用人类数据库)
CellChatDB <- CellChatDB.human # use CellChatDB.mouse if running on mouse data
showDatabaseCategory(CellChatDB)


# Show the structure of the database
dplyr::glimpse(CellChatDB$interaction)

# 4. 选择特定的信号类型进行分析 (此处仅使用"分泌信号 Secreted Signaling")
# use a subset of CellChatDB for cell-cell communication analysis
CellChatDB.use <- subsetDB(CellChatDB, search = "Secreted Signaling") # use Secreted Signaling

# set the used database in the object
cellchat.sc@DB <- CellChatDB.use


# 5. 预处理：识别过表达基因和相互作用
# subset the expression data of signaling genes for saving computation cost
cellchat.sc <- subsetData(cellchat.sc) # This step is necessary even if using the whole database
# future::plan("multiprocess", workers = 4) # do parallel

cellchat.sc <- identifyOverExpressedGenes(cellchat.sc)
cellchat.sc <- identifyOverExpressedInteractions(cellchat.sc)

# 6. 推断通信概率并过滤
cellchat.sc <- computeCommunProb(cellchat.sc)
# Filter out the cell-cell communication if there are only few number of cells in certain cell groups
cellchat.sc <- filterCommunication(cellchat.sc, min.cells = 10)
# 7. 提取通信结果数据框并计算信号通路水平
df.net <- subsetCommunication(cellchat.sc)

cellchat.sc <- computeCommunProbPathway(cellchat.sc)


cellchat.sc <- aggregateNet(cellchat.sc)
############################################################
#########################第二部分：高级可视化 (网络图与热图)
############################################################
# 8. 定义绘图颜色 (根据细胞类型前缀分配特定色系)
# define the color and group size of scWAT
whole_color_use_sc <- c(colorRampPalette(colors = c("#ecd9f1", "#967bce"))(length(grep("lyC|B_cell",unique(cellchat.sc@meta$ident),value = T))), #ly purple
                        colorRampPalette(colors = c("#C6DBEF", "#075a84"))(length(grep("myC|Mast",unique(cellchat.sc@meta$ident),value = T))), #my bule
                        colorRampPalette(colors = c("#F3E55C", "#E8602D"))(length(grep("sfC",unique(cellchat.sc@meta$ident),value = T))), #fb orange
                        "#C0C0C0", # grey
                        colorRampPalette(colors = c("#a6dbbb", "#359566"))(length(grep("vC",unique(cellchat.sc@meta$ident),value = T))) ##vc green
)
# 9. 绘制整体相互作用强度圆圈图
groupSize.sc <- as.numeric(table(cellchat.sc@idents))
netVisual_circle(cellchat.sc@net$weight, 
                 vertex.weight = groupSize.sc, 
                 weight.scale = T, 
                 label.edge= F, vertex.size.max = 5,
                 title.name = "Interaction weights/strength",
                 arrow.size = 0.05, color.use = whole_color_use_sc)








cellchat_df.sc <- cellchat.sc@net$weight

a <- c(intersect(rownames(cellchat_df.sc)[rowSums(cellchat_df.sc)==0],colnames(cellchat_df.sc)[colSums(cellchat_df.sc)==0]))



cellchat_df.sc <- cellchat_df.sc[!(rownames(cellchat_df.sc) %in% a), !(colnames(cellchat_df.sc) %in% a)]

annotation_col <- data.frame(row=names(table(cellchat.sc@idents)),cell_type = "a",row.names = names(table(cellchat.sc@idents)))

annotation_col$cell_type[grep("lyC|B_cell",annotation_col$row)] <- "lyC"
annotation_col$cell_type[grep("myC|Mast",annotation_col$row)] <- "myC"
annotation_col$cell_type[grep("sfC",annotation_col$row)] <- "sfC"
annotation_col$cell_type[grep("adipose",annotation_col$row)] <- "adipose"
annotation_col$cell_type[grep("vC",annotation_col$row)] <- "vC"

annotation_col <- data.frame(cell_type = annotation_col$cell_type,row.names = rownames(annotation_col))

annotation_row <- annotation_col

ann_colors <- list(cell_type = c(lyC = colorRampPalette(colors = c("#ecd9f1", "#967bce"))(3)[2], 
                                 myC = colorRampPalette(colors = c("#C6DBEF", "#075a84"))(3)[2], 
                                 sfC = colorRampPalette(colors = c("#F3E55C", "#E8602D"))(3)[2], 
                                 adipose = "#C0C0C0", 
                                 vC = colorRampPalette(colors = c("#a6dbbb", "#359566"))(3)[2]
)
)

# 10. 绘制热图 (展示不同细胞群间的通信密度)
pheatmap(cellchat_df.sc,
         cluster_cols = T,
         cluster_rows = T,
         # cellwidth = 8.5,
         # cellheight = 8.5,
         cellwidth = 7.5,
         cellheight = 7.5,
         border_color = NA,
         fontsize_number = 5,
         cutree_cols = 3,
         cutree_rows = 3,
         clustering_method = "ward.D2",
         # display_numbers = T,
         # angle_col = 45,
         treeheight_col = 20,
         treeheight_row = 20,
         fontsize = 8,
         annotation_col = annotation_col,
         annotation_row = annotation_row,
         annotation_colors = ann_colors,
         color = viridis(n = 51, alpha = 1, begin = 0, end = 1, option = "viridis")
)



temp <- cellchat_df.sc[rownames(cellchat_df.sc) %in% c("sfC16_late_CPA","adipose","sfC06_FAP","sfC10_FAP","sfC11_MSL","sfC15_FAP","myC02_LAM","myC15_Mox","myC14_Classical_Mo","vC11_Blood_EC_vein","myC00_M2","myC01_M2","myC13_M2"), 
                       colnames(cellchat_df.sc) %in% c("sfC16_late_CPA","adipose","sfC06_FAP","sfC10_FAP","sfC11_MSL","sfC15_FAP","myC02_LAM","myC15_Mox","myC14_Classical_Mo","vC11_Blood_EC_vein","myC00_M2","myC01_M2","myC13_M2")]

temp_color.sc <- c(colorRampPalette(colors = c("#C6DBEF", "#075a84"))(length(grep("myC|Mast",unique(cellchat.sc@meta$ident),value = T)))[c(1,2,3,14,15,16)], #my bule
                   colorRampPalette(colors = c("#F3E55C", "#E8602D"))(length(grep("sfC",unique(cellchat.sc@meta$ident),value = T)))[c(7,11,12,16,17)], #fb orange
                   "#C0C0C0", # grey
                   colorRampPalette(colors = c("#a6dbbb", "#359566"))(length(grep("vC",unique(cellchat.sc@meta$ident),value = T)))[c(12)]
)

netVisual_circle(temp, 
                 vertex.weight = as.numeric(table(cellchat.sc@idents)[names(table(cellchat.sc@idents)) %in% c("sfC16_late_CPA","adipose","sfC06_FAP","sfC10_FAP","sfC11_MSL","sfC15_FAP","myC02_LAM","myC15_Mox","myC14_Classical_Mo","vC11_Blood_EC_vein","myC00_M2","myC01_M2","myC13_M2")]), 
                 weight.scale = T, 
                 edge.weight.max = max(temp),title.name = "Weight",vertex.size.max = 5,
                 color.use = temp_color.sc
)

##########################################################
##########第三部分：信号通路深度分析与自动化导出
##########################################################
# 11. 批量导出各个信号通路的相互作用图 (PDF)
for (i in cellchat.sc@netP$pathways) {
  a <- netVisual_aggregate(object = cellchat.sc, 
                           signaling = i, 
                           layout = "circle",
                           vertex.weight = groupSize.sc,
                           vertex.size.max = 5,
                           color.use = whole_color_use_sc)
  aa <- ggdraw(a)
  ggsave(
    filename = paste0("sc_",i,".pdf"),
    plot = aa,
    device = NULL,
    path = NULL,
    scale = 1,
    width = 7,
    height = 7,
    units = c("in"),
    dpi = 300,
    limitsize = TRUE,
    bg = NULL
  )
}

# 12. 分析特定通路 (如 TNF, CXCL 等) 的配体-受体贡献度
pathways <- c("TNF","KIT","CXCL","CCL","IL16","IL2","CSF","GRN","GALECTIN","PAR")[c("TNF","KIT","CXCL","CCL","IL16","IL2","CSF","GRN","GALECTIN","PAR") %in% cellchat.sc@netP$pathways]

for (pathway in pathways) {
  p <- netAnalysis_contribution(cellchat.sc, signaling = pathway)
  p <- ggdraw(p)
  ggsave(
    filename = paste0("sc_",pathway,"_contribution_bar.pdf"),
    plot = p,
    device = NULL,
    path = NULL,
    scale = 1,
    width = 7,
    height = 7,
    units = c("in"),
    dpi = 300,
    limitsize = TRUE,
    bg = NULL
  )
  pairLR <- extractEnrichedLR(cellchat.sc, signaling = pathway, geneLR.return = FALSE)
  
  
  netVisual(object = cellchat.sc, 
            signaling = pathway, 
            layout = "circle",
            vertex.size.max = 5,
            color.use = whole_color_use_sc,
            weight.scale = T,
            out.format = "pdf")
}

# 13. 计算网络中心性指标 (识别发送者、接收者、中介者等角色)
# Compute the network centrality scores
cellchat.sc <- netAnalysis_computeCentrality(cellchat.sc, slot.name = "netP") # the slot 'netP' means the inferred intercellular communication network of signaling pathways
# Visualize the computed centrality scores using heatmap, allowing ready identification of major signaling roles of cell groups
netAnalysis_signalingRole_network(cellchat.sc, 
                                  signaling = "CCL", 
                                  width = 32, 
                                  height = 10, 
                                  color.use = whole_color_use_sc,
                                  font.size = 10)



# 14. 信号角色散点图 (Out-degree vs In-degree)
netAnalysis_signalingRole_scatter(cellchat.sc,color.use = whole_color_use_sc) +
  xlim(c(0,9.1)) +
  ylim(c(0,9.1)) +
  geom_abline(slope = 1) +
  theme(legend.position=c(0.1,0.9))

# 15. 功能相似性分析 (信号通路聚类)
cellchat.sc <- computeNetSimilarity(cellchat.sc, type = "functional")
cellchat.sc <- netEmbedding(cellchat.sc, type = "functional",umap.method = "uwot")
cellchat.sc <- netClustering(cellchat.sc, type = "functional")
# Visualization in 2D-space
netVisual_embedding(cellchat.sc, type = "functional", label.size = 3.5)+
  theme(legend.position=c(0.9,0.3))

02.代码逻辑

这段代码展示了一个经典的 CellChat 单细胞通讯分析流程。它通过数学建模的方法，从单细胞转录组数据中推断细胞群之间"谁在发信号"以及"谁在收信号"。

以下是该代码逻辑的三个主要阶段：

第一阶段：构建模型与数据预处理

这部分逻辑类似于"搭建舞台"。

对象初始化：加载 Seurat 对象并转换为 CellChat 对象。
配体-受体数据库匹配：导入人类参考数据库（CellChatDB），并筛选出"分泌信号（Secreted Signaling）"类别。这决定了模型后续会去匹配哪些已知的蛋白质相互作用。
统计特征识别：

identifyOverExpressedGenes：找出每类细胞中高表达的配体或受体基因。
computeCommunProb：核心计算步骤。利用质量作用定律（Law of mass action）计算每对细胞群之间每个配体-受体对的通信概率。
filterCommunication：剔除由于细胞数量过少（少于 10 个）导致的不可信通讯。

第二阶段：高级可视化与群体交互总结

这部分逻辑旨在将复杂的概率矩阵转化为直观的图表。

圆圈图 (Circle Plot)：

netVisual_circle 展现了细胞群落间的宏观联系。
线条粗细 代表通讯强度的总和，圆圈大小代表细胞群的细胞数量。

聚类热图 (Heatmap)：

通过 pheatmap 展示细胞群两两之间的通讯密度。代码中使用了 ward.D2 聚类方法，目的是将具有相似通讯模式的细胞群归类在一起。
使用自定义的颜色向量（如紫色代表淋巴系，蓝色代表髓系）来增强生物学可解释性。

亚群特定分析：

代码中通过 temp 提取了特定细胞（如 FAP、LAM、M2 巨噬细胞等）的子集矩阵，专门绘制它们之间精细的交互网络。

第三阶段：信号通路深度分析与角色识别

这部分逻辑从"分子"和"系统"层面解析通讯意义。

自动化批量导出：

利用 for 循环遍历所有识别到的通路（如 TNF、CXCL 等），将每个通路的通讯网络自动保存为 PDF 文件。

角色定义 (Signaling Role)：

netAnalysis_computeCentrality：计算网络中心性指标。
散点图逻辑：横坐标通常为流出信号强度（Out-degree，代表作为"发送者"的能力），纵坐标为流入信号强度（In-degree，代表作为"接收者"的能力）。位于对角线以上的点更多地扮演接收者角色。

功能流流行分析 (Functional Similarity)：

computeNetSimilarity & netEmbedding：通过 UMAP 降维的方法，将具有相似通讯模式的信号通路聚在一起。如果两个通路在图中距离很近，说明它们在这些细胞群中发挥着类似的调控作用。

代码中的关键自定义点：

正则表达式分配颜色 ：使用 grep 匹配细胞名称前缀（如 lyC, myC, sfC）来自动化分配色调。这种逻辑在处理 105 个样本或大量亚群时非常高效，确保了同谱系细胞颜色相近。
计算成本优化 ：通过 subsetData 仅保留与通讯数据库相关的基因，避免了在大规模矩阵上进行无效运算。

https://www.nature.com/articles/s41467-023-36983-2#data-availability

01.全部代码

02.代码逻辑

第一阶段：构建模型与数据预处理

第二阶段：高级可视化与群体交互总结

第三阶段：信号通路深度分析与角色识别

代码中的关键自定义点：

03.代码解读