1、简介 视频教程：请点击 Cellchat 基础分析教程视频链接。
2、安装并加载R包 suppressMessages ( if ( ! require (CellChat))devtools :: install_github ( "sqjin/CellChat" )) suppressMessages ( if ( ! require (ggplot2)) install.packages ( "ggplot2" )) suppressMessages ( if ( ! require (patchwork)) install.packages ( "patchwork" ) ) suppressMessages ( if ( ! require (ggalluvial)) install.packages ( "ggalluvial" )) suppressMessages ( if ( ! require (igraph)) install.packages ( "igraph" )) suppressMessages ( if ( ! require (dplyr)) install.packages ( "dplyr" )) 3、下载、读取、创建cellchat对象 Sys.time # [1] "2025-05-15 11:06:22 CST" # 示例数据：来源于人类皮肤 # 下载地址：https://ndownloader.figshare.com/files/25950872 rm ( list = ls ) gc # used (Mb) gc trigger (Mb) max used (Mb) # Ncells 4378697 233.9 8513810 454.7 5569683 297.5 # Vcells 7313817 55.8 12458379 95.1 10290480 78.6 setwd ( "/data/07_scRNA-seq_cell_communication/" ) load ( "data/data_humanSkin_CellChat.rda" ) # 查看数据类型 class (data_humanSkin) # [1] "list" # 获取表达矩阵 data <- data_humanSkin $ data[ 1 : 4 , 1 : 4 ] # 4 x 4 sparse Matrix of class "dgCMatrix" # S1_AACTCCCAGAGCTGCA S1_CAACCAATCCTCATTA S1_CGCTATCTCCTAGTGA # A1BG 0.5774867 1.121317 . # A1BG-AS1 0.5774867 . . # A2M . . . # A2M-AS1 . . . # S1_ATTTCTGCAGGACGTA # A1BG 0.8604636 # A1BG-AS1 . # A2M . # A2M-AS1 . dim (data) # [1] 17328 7563 # 获取细胞描述信息，行名为细胞barcode名称 meta <- data_humanSkin $ meta head (meta) # patient.id condition labels # S1_AACTCCCAGAGCTGCA Patient1 LS Inflam. FIB # S1_CAACCAATCCTCATTA Patient1 LS FBN1+ FIB # S1_CGCTATCTCCTAGTGA Patient1 LS Inflam. FIB # S1_ATTTCTGCAGGACGTA Patient1 LS Inflam. FIB # S1_TGAGCCGAGCTGGAAC Patient1 LS Inflam. FIB # S1_CAGGTGCAGCCCAACC Patient1 LS Inflam. FIB dim (meta) # [1] 7563 3 # 查看分组名称 unique (meta $ condition) # [1] "LS" "NL" # 按指定的变量提取细胞baocode，这里提取出LS组的细胞baocode cell.use <- rownames (meta)[meta $ condition == "LS" ] head (cell.use) # [1] "S1_AACTCCCAGAGCTGCA" "S1_CAACCAATCCTCATTA" "S1_CGCTATCTCCTAGTGA" # [4] "S1_ATTTCTGCAGGACGTA" "S1_TGAGCCGAGCTGGAAC" "S1_CAGGTGCAGCCCAACC" # 取出对应细胞表达矩阵 data_LS <- data[, cell.use] dim (data_LS) # [1] 17328 5011 # 取出对应细胞的meta信息 meta_LS <- meta[cell.use, ] dim (meta_LS) # [1] 5011 3 # 手动创建meta_LS数据框 # meta_test <- data.frame(patient.id = meta[cell.use, "patient.id"], # condition = meta[cell.use, "condition"], # labels = meta[cell.use,"labels"], # row.names = colnames(data_LS)) # dim(meta_test) cellchat <- createCellChat ( object = data_LS, meta = meta_LS, group.by = "labels" ) # [1] "Create a CellChat object from a data matrix" # Set cell identities for the new CellChat object # The cell groups used for CellChat analysis are APOE+ FIB FBN1+ FIB COL11A1+ FIB Inflam. FIB cDC1 cDC2 LC Inflam. DC TC Inflam. TC CD40LG+ TC NKT cellchat # An object of class CellChat created from a single dataset # 17328 genes. # 5011 cells. # CellChat analysis of single cell RNA-seq data! # 如果上述没有指定meta=meta，可以如下手动加入 # cellchat_test <- createCellChat(object = data) # cellchat_test <- addMeta(cellchat, meta = meta) # 用meta中的注释作为分组依据 # cellchat_test <- setIdent(cellchat, ident.use = "labels") # cellchat_test # 细胞类型种类 levels (cellchat @ idents) # show factor levels of the cell labels # [1] "APOE+ FIB" "FBN1+ FIB" "COL11A1+ FIB" "Inflam. FIB" "cDC1" # [6] "cDC2" "LC" "Inflam. DC" "TC" "Inflam. TC" # [11] "CD40LG+ TC" "NKT" # 每种细胞类型数目 table (cellchat @ idents) # # APOE+ FIB FBN1+ FIB COL11A1+ FIB Inflam. FIB cDC1 cDC2 # 1228 813 181 484 121 294 # LC Inflam. DC TC Inflam. TC CD40LG+ TC NKT # 67 81 765 266 630 81 4、载入数据库并开始计算 # 物种为人，设置数据库为CellChatDB.human，如果是小鼠的则换成CellChatDB.mouse CellChatDB <- CellChatDB.human # 展示 CellChat 数据库（CellChatDB）中的配体 - 受体相互作用数据的分类信息，“Secreted Signaling”（分泌信号）、“ECM - Receptor”（细胞外基质 - 受体）和 “Cell - Cell Contact”（细胞 - 细胞接触） showDatabaseCategory (CellChatDB) # dplyr::glimpse 函数用于快速查看数据框或者数据框类似对象的结构和内容，它会以一种紧凑的格式展示数据的基本信息，包括列名、列的数据类型以及每列的前几个值 dplyr :: glimpse (CellChatDB $ interaction) # Rows: 1,939 # Columns: 11 # $ interaction_name <chr> "TGFB1_TGFBR1_TGFBR2", "TGFB2_TGFBR1_TGFBR2", "TGFB… # $ pathway_name <chr> "TGFb", "TGFb", "TGFb", "TGFb", "TGFb", "TGFb", "TG… # $ ligand <chr> "TGFB1", "TGFB2", "TGFB3", "TGFB1", "TGFB1", "TGFB2… # $ receptor <chr> "TGFbR1_R2", "TGFbR1_R2", "TGFbR1_R2", "ACVR1B_TGFb… # $ agonist <chr> "TGFb agonist", "TGFb agonist", "TGFb agonist", "TG… # $ antagonist <chr> "TGFb antagonist", "TGFb antagonist", "TGFb antagon… # $ co_A_receptor <chr> "", "", "", "", "", "", "", "", "", "", "", "", "",… # $ co_I_receptor <chr> "TGFb inhibition receptor", "TGFb inhibition recept… # $ evidence <chr> "KEGG: hsa04350", "KEGG: hsa04350", "KEGG: hsa04350… # $ annotation <chr> "Secreted Signaling", "Secreted Signaling", "Secret… # $ interaction_name_2 <chr> "TGFB1 - (TGFBR1+TGFBR2)", "TGFB2 - (TGFBR1+TGFBR2)… # 使用所有的分类用作分析数据库 # CellChatDB.use <- CellChatDB # 取出部分分类用作分析数据库 CellChatDB.use <- subsetDB (CellChatDB, search = "Secreted Signaling" ) # 将数据库内容载入cellchat对象中 cellchat @ DB <- CellChatDB.use # 表达量预处理 # 在 CellChatDB.use 中对信号基因的表达数据进行子集处理 cellchat <- subsetData (cellchat, features = NULL ) # 寻找高表达的基因 cellchat <- identifyOverExpressedGenes (cellchat) # identifyOverExpressedInteractions函数用于寻找高表达的细胞间相互作用（配体 - 受体相互作用）。
细胞间的通讯是通过配体与受体的结合来实现的，高表达的相互作用可能代表着更活跃的细胞通讯通路。函数会基于基因表达数据以及配体 - 受体相互作用信息，找出那些表达水平较高的相互作用，结果同样会存储在cellchat对象中 cellchat <- identifyOverExpressedInteractions (cellchat) # 将cellchat对象中的数据投影到人类蛋白质 - 蛋白质相互作用网络（PPI.human）上。
蛋白质 - 蛋白质相互作用网络能够提供额外的信息，帮助进一步理解细胞间通讯的分子机制。通过投影操作，可以将细胞间通讯分析与蛋白质相互作用网络相结合，挖掘出更多潜在的生物学意义 cellchat <- projectData (cellchat, PPI.human) # 计算细胞间通讯的概率。细胞间通讯并非是绝对的，而是存在一定的概率。
computeCommunProb函数会根据基因表达数据、配体 - 受体相互作用信息等，采用默认的计算方式（这里 type = "truncatedMean"）来计算不同细胞群体之间通讯的概率。raw.use = T 表示使用原始的基因表达数据进行计算。
计算得到的通讯概率会存储在 cellchat 对象中，为后续分析细胞间通讯的强度和模式提供依据 # 默认cutoff的值为20%，即表达比例在25%以下的基因会被认为是0，trim = 0.1可以调整比例阈值 cellchat <- computeCommunProb (cellchat, raw.use = T) # triMean is used for calculating the averagene expression per cell group. # [1] ">>> Run CellChat on sc/snRNA-seq data <<< [2025-05-15 11:10:57.088421]" # [1] ">>> CellChat inference is done. Parameter values are stored in `object@options$parameter` <<< [2025-05-15 11:14:10.908108]" # 对细胞间通讯结果进行过滤。
min.cells = 10 表示只保留那些涉及至少 10 个细胞的通讯相互作用。在实际分析中，一些细胞间的通讯可能只涉及极少数细胞，这些通讯可能是噪声或者不具有普遍意义。
通过设置最小细胞数的阈值，可以过滤掉这些可能的噪声数据，使得分析结果更加可靠 cellchat <- filterCommunication (cellchat, min.cells = 10 ) # 从 cellchat 对象中提取细胞间通讯的相关信息，并将其存储在一个数据框 df.net 中。这个数据框包含了经过前面一系列分析和过滤后得到的细胞间通讯的关键信息，例如细胞群体之间的通讯概率、涉及的配体 - 受体相互作用等。
通过这个数据框，你可以方便地进行后续的数据可视化、统计分析等操作 df.net <- subsetCommunication (cellchat) # DT 包是一个用于创建交互式表格的 R 包，它基于 JavaScript 库 DataTables。
datatable 函数的主要作用是将数据框转换为一个交互式的 HTML 表格，这个表格具有丰富的交互功能，例如排序、筛选、分页等 DT :: datatable (df.net) write.csv (df.net, "./result_cellchat/01.df.net.csv" ) # computeCommunProbPathway 函数的主要功能是计算细胞间通讯在信号通路层面的概率。
在细胞间通讯分析里，仅仅知道细胞群体之间存在通讯是不够的，还需要了解这些通讯是通过哪些信号通路来实现的，以及每条信号通路的通讯概率是多少。该函数会基于之前计算得到的细胞间通讯概率（例如通过 computeCommunProb 函数计算），进一步分析每条信号通路在不同细胞群体之间的通讯概率。
# 每对配受体的预测结果存在net中，每条通路的预测结果存在netp中 cellchat <- computeCommunProbPathway (cellchat) # 计算联路数与通讯概率，可用sources.use and targets.use指定来源与去向 cellchat <- aggregateNet (cellchat) 5、可视化 # 统计每类细胞的数目 groupSize <- as.numeric ( table (cellchat @ idents)) library (patchwork) # 表示将绘图区域划分为 1 行 3 列的网格布局，并且允许图形元素绘制在绘图区域之外，这样在绘制一些带有标签、注释等可能超出绘图框的图形时，这些超出部分也能正常显示 par ( mfrow = c ( 1 , 3 ), xpd= TRUE ) netVisual_circle (cellchat @ net $ count, vertex.weight = groupSize, # 指定节点（细胞类型）权重，节点大小会根据这个权重进行调整，这里依据细胞数目 weight.scale = T, label.edge= F, title.name = "Number of interactions" ) netVisual_circle (cellchat @ net $ weight, vertex.weight = groupSize, weight.scale = T, label.edge= F, title.name = "Interaction weights/strength" ) netVisual_circle (cellchat @ net $ weight, vertex.weight = groupSize, weight.scale = T, label.edge= F, title.name = "Interaction weights/strength" , targets.use = "cDC2" ) cDC2 细胞群体相关的通讯相互作用 mat <- cellchat @ net $ count par ( mfrow = c ( 3 , 4 ), xpd= TRUE ) for (i in 1 : nrow (mat)) { # mat2 <- matrix ( 0 , nrow = nrow (mat), ncol = ncol (mat), dimnames = dimnames (mat)) mat2[i, ] <- mat[i, ] netVisual_circle (mat2, vertex.weight = groupSize, weight.scale = T, edge.weight.max = max (mat), title.name = rownames (mat)[i]) } mat <- cellchat @ net $ weight par ( mfrow = c ( 3 , 4 ), xpd= TRUE ) for (i in 1 : nrow (mat)) { mat2 <- matrix ( 0 , nrow = nrow (mat), ncol = ncol (mat), dimnames = dimnames (mat)) mat2[i, ] <- mat[i, ] netVisual_circle (mat2, vertex.weight = groupSize, weight.scale = T, edge.weight.max = max (mat), title.name = rownames (mat)[i]) } 6、进阶可视化 pathways.show <- df.net $ pathway_name pathways.show[ 1 ] # [1] "FGF" # 层次图（Hierarchy plot） par ( mfrow = c ( 1 , 2 ), xpd= TRUE ) vertex.receiver = seq ( 1 , 4 ) netVisual_aggregate (cellchat, signaling = pathways.show[ 1 ], vertex.receiver = vertex.receiver, layout = "hierarchy" ) netVisual_aggregate (cellchat, signaling = pathways.show[ 1 ], layout = "circle" ) # 采用弦图（chord diagram）的布局方式来展示细胞间的通讯关系 netVisual_aggregate (cellchat, signaling = pathways.show[ 1 ], layout = "chord" ) # 分组展示弦图 group.cellType <- c ( rep ( "FIB" , 4 ), rep ( "DC" , 4 ), rep ( "TC" , 4 )) names (group.cellType) <- levels (cellchat @ idents) group.cellType # APOE+ FIB FBN1+ FIB COL11A1+ FIB Inflam. FIB cDC1 cDC2 # "FIB" "FIB" "FIB" "FIB" "DC" "DC" # LC Inflam. DC TC Inflam. TC CD40LG+ TC NKT # "DC" "DC" "TC" "TC" "TC" "TC" par ( mfrow = c ( 1 , 2 ), xpd= TRUE ) netVisual_chord_cell (cellchat, signaling = pathways.show[ 1 ], group = group.cellType, title.name = paste0 (pathways.show[ 1 ], " signaling network" )) netVisual_chord_cell (cellchat, signaling = pathways.show[ 1 ], title.name = paste0 (pathways.show[ 1 ], " signaling network" )) 7、配受体展示 # 展现对特定通路的贡献程度 p1 <- netAnalysis_contribution (cellchat, signaling = "MIF" , title = "MIF" ) # 计算每对配体-受体对整体信号通路的贡献，并可视化由单一配体-受体对介导的细胞间通信。
p2 <- netAnalysis_contribution (cellchat, signaling = pathways.show) cowplot :: plot_grid (p1, p2, align = "h" , ncol= 2 ) pairLR.CXCL <- extractEnrichedLR (cellchat, signaling = pathways.show[ 1 ], geneLR.return = FALSE ) # 提取第一个显著的配受体对 LR.show <- pairLR.CXCL[ 1 ,] # 对应前四个可以作为受体的细胞类型 # 如果出现Error in plot.new : figure margins too large报错，请把plot窗口拉大一些 vertex.receiver = seq ( 1 , 4 ) p1 <- netVisual_individual (cellchat, signaling = pathways.show, pairLR.use = LR.show, vertex.receiver = vertex.receiver, layout = "hierarchy" ) vertex.receiver = seq ( 1 , 7 ) p2 <- netVisual_individual (cellchat, signaling = pathways.show, pairLR.use = LR.show, vertex.receiver = vertex.receiver, layout = "hierarchy" ) # cowplot::plot_grid(p1, p2 ,align = "h",ncol=1) LR.show # [1] "FGF7_FGFR1" # 单个互作对圈图 netVisual_individual (cellchat, signaling = pathways.show[ 1 ], pairLR.use = LR.show, layout = "circle" ) # [[1]] # 单个互作对弦图 netVisual_individual (cellchat, signaling = pathways.show[ 1 ], pairLR.use = LR.show, layout = "chord" ) # [[1]] 8、通路展示 pathways.show.all <- cellchat @ netP $ pathways.show.all # [1] "MIF" "GALECTIN" "CXCL" "COMPLEMENT" "FGF" # [6] "TNF" "CCL" "GAS" "IL4" "CD40" # [11] "LIGHT" "CSF" "VEGF" for (i in 1 : length (pathways.show.all)) { gg <- netAnalysis_contribution (cellchat, signaling = pathways.show.all[i]) ggsave ( filename= paste0 ( "result_cellchat/" ,pathways.show.all[i], "_L-R_contribution.pdf" ), plot= gg, width = 7 , height = 7 , units = "in" , dpi = 300 ) } netAnalysis_contribution (cellchat, signaling = pathways.show.all) 9、多个细胞通讯通路气泡图可视化 levels (cellchat @ idents) # [1] "APOE+ FIB" "FBN1+ FIB" "COL11A1+ FIB" "Inflam. FIB" "cDC1" # [6] "cDC2" "LC" "Inflam. DC" "TC" "Inflam. TC" # [11] "CD40LG+ TC" "NKT" par ( mfrow = c ( 1 , 4 ), xpd= TRUE ) p1 <- netVisual_bubble (cellchat, sources.use = 4 , targets.use = c ( 5 : 11 ), remove.isolate = FALSE ) + # 将 x 轴的刻度标签旋转 45 度，hjust = 1：标签右对齐（与坐标轴的刻度线对齐），vjust = 1：标签与 x 轴顶部对齐，给 x 轴的刻度标签上方添加 1 个单位的空间（即距离顶部增加） theme ( axis.text.x = element_text ( angle = 45 , hjust = 1 , vjust = 1 , margin = margin ( t = 1 ))) p2 <- netVisual_bubble (cellchat, sources.use = 4 , targets.use = c ( "cDC1" , "cDC2" , "LC" , "Inflam. DC" , "TC" , "Inflam. TC" , "CD40LG+ TC" ), remove.isolate = FALSE ) + theme ( axis.text.x = element_text ( angle = 45 , hjust = 1 , vjust = 1 , margin = margin ( t = 1 ))) p3 <- netVisual_bubble (cellchat, sources.use = 4 , targets.use = c ( "cDC1" , "cDC2" ), remove.isolate = FALSE ) + theme ( axis.text.x = element_text ( angle = 45 , hjust = 1 , vjust = 1 , margin = margin ( t = 1 ))) p4 <- netVisual_bubble (cellchat, sources.use = 4 , targets.use = c ( 5 : 11 ), signaling = c ( "CCL" , "CXCL" ), remove.isolate = FALSE ) + theme ( axis.text.x = element_text ( angle = 45 , hjust = 1 , vjust = 1 , margin = margin ( t = 1 ))) cowplot :: plot_grid (p1, p2,p3,p4, align = "h" , ncol= 4 ) par ( mfrow = c ( 1 , 3 ), xpd= TRUE ) pairLR.use <- extractEnrichedLR (cellchat, signaling = c ( "CCL" , "CXCL" , "MIF" )) pairLR.use # interaction_name # 1 CCL19_CCR7 # 2 CXCL12_CXCR4 # 3 CXCL12_ACKR3 # 4 MIF_CD74_CXCR4 # 5 MIF_CD74_CD44 # 6 MIF_ACKR3 p1 <- netVisual_bubble (cellchat, sources.use = c ( 3 , 4 ), targets.use = c ( 5 : 8 ), pairLR.use = pairLR.use, remove.isolate = TRUE ) + # 将 x 轴的刻度标签旋转 45 度，hjust = 1：标签右对齐（与坐标轴的刻度线对齐），vjust = 1：标签与 x 轴顶部对齐，给 x 轴的刻度标签上方添加 1 个单位的空间（即距离顶部增加） theme ( axis.text.x = element_text ( angle = 45 , hjust = 1 , vjust = 1 , margin = margin ( t = 1 ))) p2 <- netVisual_bubble (cellchat, sources.use = 4 , targets.use = c ( 5 : 11 ), signaling = c ( "CCL" , "CXCL" , "MIF" ), remove.isolate = FALSE ) + theme ( axis.text.x = element_text ( angle = 45 , hjust = 1 , vjust = 1 , margin = margin ( t = 1 ))) # 孤立节点：在细胞通讯网络分析里，孤立节点指的是那些没有与其他节点（细胞类型）产生信号通讯的节点。
也就是该细胞类型既不向其他细胞类型发送信号，也不接收其他细胞类型发出的信号 # remove.isolate 设置成 TRUE 时，netVisual_bubble函数会在绘图之前将所有孤立的节点从网络中移除。
这样做的好处是能够让可视化的结果更加简洁，把重点聚焦在那些存在信号通讯的细胞类型上，避免孤立节点对整体网络结构和信号通讯模式的干扰 # p3 <- netVisual_bubble (cellchat, sources.use = 4 , targets.use = c ( 5 : 11 ), signaling = c ( "CCL" , "CXCL" , "MIF" ), remove.isolate = T) + theme ( axis.text.x = element_text ( angle = 45 , hjust = 1 , vjust = 1 , margin = margin ( t = 1 ))) cowplot :: plot_grid (p1, p2,p3, align = "h" , ncol= 3 ) 10、多组别细胞通讯 视频教程：请点击 CellChat 多组别通讯视频链接 这部分的内容主要分析目的为：1、细胞通讯在不同组别中是否发生变化 2、细胞通讯在不同细胞类型中是否发生变化 3、细胞通讯的“发起者”与接收者是否随组别发生变化 10.1 准备工作 library (CellChat) library (patchwork) library (cowplot) dir.create ( "./comparison" ) setwd ( "./comparison" ) # 下载地址：cellchat.NL <- readRDS ( "data/cellchat_humanSkin_NL.rds" ) cellchat.LS <- readRDS ( "data/cellchat_humanSkin_LS.rds" ) # 如果出现报错：no slot of name "images" for this object of class "CellChat"，是因为cellchat版本不同导致的，可以先使用updateCellChat函数将之前对象更新后再执行mergeCellChat合并的操作 cellchat.NL <- updateCellChat (cellchat.NL) cellchat.LS <- updateCellChat (cellchat.LS) object.list <- list ( NL = cellchat.NL, LS = cellchat.LS) cellchat <- mergeCellChat (object.list, add.names = names (object.list)) cellchat # An object of class CellChat created from a merged object with multiple datasets # 555 signaling genes. # 7563 cells. # CellChat analysis of single cell RNA-seq data! 10.2 可视化 最简单的展示，查看细胞互作的数量在不同条件下是否有差异 # 比较cellchat对象里group1和group2之间的细胞间相互作用 # measure：该参数指定了用于比较相互作用的衡量指标。
默认值为"count"，也就是相互作用的次数 # 在第二行代码中，measure = "weight" 表明使用相互作用的权重来进行比较。gg1 <- compareInteractions (cellchat, show.legend = F, group = c ( 1 , 2 )) # 权重反映了特定细胞群之间信号传递的相对强度。
例如，一个高权重的相互作用可能意味着发送细胞群能够高效地产生并释放信号分子，而接收细胞群对这些信号分子有高度的响应能力。这种相互作用在细胞的生理过程（如细胞增殖、分化、免疫反应等）中可能起着更为关键的作用。
影响因素包括了信号分子的表达水平、受体的表达水平、信号通路的活性 gg2 <- compareInteractions (cellchat, show.legend = F, group = c ( 1 , 2 ), measure = "weight" ) gg1 + gg2 # 查看细胞通路在两组间的富集程度 # 比较每个信号传导途径的信息流来识别保守的和特定于情境的信号传导途径，信息流由推断网络中所有细胞对之间的通信概率之和 (即网络中的总权重) 定义。
# 条形图可以用堆叠模式绘制，也可以不用。重要的信号传导途径根据NL和LS组之间推断网络内整体信息流的差异进行排序。顶部红色的信号传导途径在NL中富集，而这些绿色的信号传导途径在LS中富集。
gg1 <- rankNet (cellchat, mode = "comparison" , stacked = T, do.stat = TRUE ) gg2 <- rankNet (cellchat, mode = "comparison" , stacked = F, do.stat = TRUE ) gg1 + gg2 以 circle plot 的形式展示第二个组别中相较于第一个组别细胞通讯发生的变化，红色为上调蓝色为下调 par ( mfrow = c ( 1 , 2 ), xpd= TRUE ) # 不同细胞群体之间的交互次数或交互强度差异，可以使用圆形图可视化两个数据集之间细胞-细胞通信网络中的交互次数或交互强度差异 netVisual_diffInteraction (cellchat, weight.scale = T) netVisual_diffInteraction (cellchat, weight.scale = T, measure = "weight" ) 以上是直接展示二组“相减”的结果，当然你也可以直接将两组分开展示: # getMaxWeight 是用来提取在 object.list 中每个 CellChat 对象的最大权重值。
这个函数根据指定的 attribute 参数计算最大的权重值。attribute = c("idents", "count") 表示从每个对象中的 idents（即细胞标识符）和 count（即互动计数）属性中提取最大权重值。
weight.max <- getMaxWeight (object.list, attribute = c ( "idents" , "count" )) # par(mfrow = c(1,2)) 表示将绘图区域分为1行2列，用来并排显示两个图，xpd=TRUE允许文本标签在绘图区域外显示 par ( mfrow = c ( 1 , 2 ), xpd= TRUE ) # 遍历object.list中的每一个CellChat对象细胞通讯网络的计数矩阵，其中每个元素代表细胞之间的交互数量 # 将权重缩放到一个标准范围，以便使不同的网络图具有一致的显示比例 # 使用之前计算的最大权重来设定边的最大权重，以确保所有的网络图在权重上保持一致性 # 设置边的最大宽度，用来调节视觉效果，确保较强的互动路径更为突出 # 设置每个子图的标题 # 线条越粗则互作对数越多 for (i in 1 : length (object.list)) { netVisual_circle (object.list[[i]] @ net $ count, weight.scale = T, label.edge= F, edge.weight.max = weight.max[ 2 ], edge.width.max = 12 , title.name = paste0 ( "Number of interactions - " , names (object.list)[i])) } 同理，用 heatmap 也可以进行展示 # 以heatmap的形式展示第二个组别中相较于第一个组别细胞通讯发生的变化，红色为上调蓝色为下调 # 左图count 反映的是细胞间通讯的频率或次数 # 右图weight反映的是细胞间通讯的互作强度 gg1 <- netVisual_heatmap (cellchat) gg2 <- netVisual_heatmap (cellchat, measure = "weight" ) gg1 + gg2 展示特定通路展示圈图、热图和弦图 # 指定要分析的细胞通讯通路是 "CXCL"，一种常见的趋化因子家族，通常涉及免疫系统中的细胞迁移 # 圈图 pathways.show <- c ( "CXCL" ) # 这行代码获取指定通路 ("CXCL") 在object.list中所有CellChat对象的最大权重 # slot.name = "netP" 表示从每个CellChat对象中获取名为netP的slot，这个slot包含了细胞间通讯的网络信息 weight.max <- getMaxWeight (object.list, slot.name = c ( "netP" ), attribute = pathways.show) par ( mfrow = c ( 1 , 2 ), xpd= TRUE ) # 将最大权重设置为先前计算的最大值，以确保不同数据集之间的权重尺度一致 # 设置边的最大宽度为10，影响图中边的粗细，帮助突出重要的通讯路径 # signaling.name设置图的标题,显示的是当前通路和数据集的名称 for (i in 1 : length (object.list)) { netVisual_aggregate (object.list[[i]], signaling = pathways.show, layout = "circle" , edge.weight.max = weight.max[ 1 ], edge.width.max = 10 , signaling.name = paste (pathways.show, names (object.list)[i])) } # 热图 pathways.show <- c ( "CXCL" ) par ( mfrow = c ( 1 , 2 ), xpd= TRUE ) ht <- list # 热图展示 "CXCL" 通路在不同细胞类型之间的通讯强度 # 设置热图颜色方案为红色渐变，用于显示通讯强度的高低 # 为每个热图设置标题，显示通路名称和数据集名称 for (i in 1 : length (object.list)) { ht[[i]] <- netVisual_heatmap (object.list[[i]], signaling = pathways.show, color.heatmap = "Reds" , title.name = paste (pathways.show, "signaling " , names (object.list)[i])) } # 保存在ht列表中的热图绘制在同一面板上，ht_gap = unit(0.5, "cm") 设置热图之间的间距为 0.5 厘米 ComplexHeatmap :: draw (ht[[ 1 ]] + ht[[ 2 ]], ht_gap = unit ( 0.5 , "cm" )) # 弦图 # 更粗的箭头 表示该细胞对之间的通讯更强 pathways.show <- c ( "CXCL" ) par ( mfrow = c ( 1 , 2 ), xpd= TRUE ) for (i in 1 : length (object.list)) { netVisual_aggregate (object.list[[i]], signaling = pathways.show, layout = "chord" , signaling.name = paste (pathways.show, names (object.list)[i])) } 基因表达情况 # 设定图形中组别展示顺序，NL在前，LS在后 cellchat @ meta $ datasets = factor (cellchat @ meta $ datasets, levels = c ( "NL" , "LS" )) # 指定了要可视化的信号通路为CXCL # 划分不同的数据集进行对比展示 # 在可视化中使用 ggplot2 的默认配色方案 plotGeneExpression (cellchat, signaling = "CXCL" , split.by = "datasets" , colors.ggplot = T) 研究细胞类型之间的通讯差异 # 检查这两个数据集的细胞类型（idents）是否一致 levels (object.list[[ 1 ]] @ idents) # [1] "APOE+ FIB" "FBN1+ FIB" "COL11A1+ FIB" "Inflam. FIB" "cDC1" # [6] "cDC2" "LC" "Inflam. DC" "TC" "Inflam. TC" # [11] "CD40LG+ TC" "NKT" levels (object.list[[ 2 ]] @ idents) # [1] "APOE+ FIB" "FBN1+ FIB" "COL11A1+ FIB" "Inflam. FIB" "cDC1" # [6] "cDC2" "LC" "Inflam. DC" "TC" "Inflam. TC" # [11] "CD40LG+ TC" "NKT" # 定义了一个包含细胞类型信息的向量。
这里假设有三种细胞类型（"FIB"、"DC"、"TC"），并且每种类型有4种细胞 group.cellType <- c ( rep ( "FIB" , 4 ), rep ( "DC" , 4 ), rep ( "TC" , 4 )) # 将 group.cellType 转换为因子，并指定因子的顺序为"FIB" -> "DC" -> "TC" group.cellType <- factor (group.cellType, levels = c ( "FIB" , "DC" , "TC" )) # 将group.cellType作为新的细胞类型信息合并到每个CellChat对象中。
这会更新object.list中的每个 CellChat 对象，确保每个对象的细胞类型标签被正确地合并 object.list <- lapply (object.list, function (x) { mergeInteractions (x, group.cellType)}) # 将object.list中的所有CellChat对象合并成一个单一的CellChat对象。
这一步是将不同数据集（例如，不同实验条件下的数据）进行合并，便于进行跨数据集的比较 cellchat <- mergeCellChat (object.list, add.names = names (object.list)) # 直接展示相减的结果 # 展示基于合并后的细胞通讯计数（count.merged）的差异 par ( mfrow = c ( 1 , 2 ), xpd= TRUE ) netVisual_diffInteraction (cellchat, weight.scale = T, measure = "count.merged" , label.edge = T) # 展示基于合并后的细胞通讯强度（weight.merged）的差异 netVisual_diffInteraction (cellchat, weight.scale = T, measure = "weight.merged" , label.edge = T) # 两组分别展示 # getMaxWeight 函数用于获取object.list中指定槽位和属性的最大权重，这里分别考虑了细胞身份、相互作用计数和合并后的相互作用计数 weight.max <- getMaxWeight (object.list, slot.name = c ( "idents" , "net" , "net" ), attribute = c ( "idents" , "count" , "count.merged" )) par ( mfrow = c ( 1 , 2 ), xpd= TRUE ) # 使用for循环遍历 object.list中的每个对象，netVisual_circle函数以圆形布局可视化细胞间相互作用网络 # 使用合并后的相互作用计数count.merged作为边的权重 # weight.scale=T表示对权重进行缩放 # label.edge=T表示显示边的标签 # edge.weight.max 设置边的最大权重为之前获取的最大权重 # edge.width.max设置边的最大宽度为12 # title.name 为每个图添加标题，显示相互作用数量和对象名称 for (i in 1 : length (object.list)) { netVisual_circle (object.list[[i]] @ net $ count.merged, weight.scale = T, label.edge= T, edge.weight.max = weight.max[ 3 ], edge.width.max = 12 , title.name = paste0 ( "Number of interactions - " , names (object.list)[i])) } 展示两组间各类细胞 incoming 与 outcoming 通讯的强度 # x@net$count为CellChat对象中存储细胞间通讯计数的矩阵。
矩阵中的每个元素表示一个细胞对之间的通讯计数。# rowSums(x@net$count)：计算每行（细胞源）上的总通讯数量，即每个细胞源的所有目标细胞的通讯总数。# colSums(x@net$count)：计算每列（细胞目标）上的总通讯数量，即每个目标细胞的所有源细胞的通讯总数。
# diag(x@net$count)取矩阵的对角线元素，这些通常表示细胞本身与自己的通讯，需要将这些对角线元素减去，因为它们不代表细胞间的通讯 # num.link：这会输出一个包含每个CellChat对象中每个细胞类型的通讯总数 num.link <- sapply (object.list, function (x) { rowSums (x @ net $ count) + colSums (x @ net $ count) - diag (x @ net $ count)}) num.link # weight.MinMax 存储了所有对象中链接数量的最小值和最大值，用于控制不同数据集散点图中散点的大小 weight.MinMax <- c ( min (num.link), max (num.link)) gg <- list # 生成每个CellChat对象不同细胞类型通讯总数的散点图 for (i in 1 : length (object.list)) { gg[[i]] <- netAnalysis_signalingRole_scatter (object.list[[i]], title = names (object.list)[i], weight.MinMax = weight.MinMax) } p1 <- patchwork :: wrap_plots ( plots = gg) png ( "/data/07_scRNA-seq_cell_communication/img/cellchat.png" , width = 720 , height = 360 ) print (p1) dev.off 展示两组间的差异 # 对 CellChat 对象中的两种不同细胞类型（"Inflam. DC" 和 "cDC1"）进行信号传导变化的散点图分析，同时排除 "MIF" 信号通路的影响，最后将两个散点图组合在一起，以便直观地比较这两种细胞类型在信号传导方面的差异 gg1 <- netAnalysis_signalingChanges_scatter (cellchat, idents.use = "Inflam. DC" , signaling.exclude = "MIF" ) gg2 <- netAnalysis_signalingChanges_scatter (cellchat, idents.use = "cDC1" , signaling.exclude = c ( "MIF" )) patchwork :: wrap_plots ( plots = list (gg1,gg2)) 继续探索outgoing与incoming的组间模式差异 suppressMessages ( library (ComplexHeatmap)) i = 1 # outgoing 传出信号，作为发送者角色即配体 # 使用union函数将这两个CellChat对象的信号通路合并，得到这两个数据集中所有信号通路的并集 pathway.union <- union (object.list[[i]] @ netP $ pathways, object.list[[i + 1 ]] @ netP $ pathways) # 生成信号通路角色的热图，将展示在每个数据集中，细胞在信号通路中的“outgoing”角色（即发送信号的角色） ht1 = netAnalysis_signalingRole_heatmap (object.list[[i]], pattern = "outgoing" , signaling = pathway.union, title = names (object.list)[i], width = 5 , height = 6 ) ht2 = netAnalysis_signalingRole_heatmap (object.list[[i + 1 ]], pattern = "outgoing" , signaling = pathway.union, title = names (object.list)[i + 1 ], width = 5 , height = 6 ) draw (ht1 + ht2, ht_gap = unit ( 0.5 , "cm" )) # incoming 传入信号，作为接收者即受体 ht1 = netAnalysis_signalingRole_heatmap (object.list[[i]], pattern = "incoming" , signaling = pathway.union, title = names (object.list)[i], width = 5 , height = 6 , color.heatmap = "GnBu" ) ht2 = netAnalysis_signalingRole_heatmap (object.list[[i + 1 ]], pattern = "incoming" , signaling = pathway.union, title = names (object.list)[i + 1 ], width = 5 , height = 6 , color.heatmap = "GnBu" ) draw (ht1 + ht2, ht_gap = unit ( 0.5 , "cm" )) # overall # 这次展示的是 overall 角色，即展示细胞在信号通路中的所有角色（既包括发送信号的角色，又包括接收信号的角色） ht1 = netAnalysis_signalingRole_heatmap (object.list[[i]], pattern = "all" , signaling = pathway.union, title = names (object.list)[i], width = 5 , height = 6 , color.heatmap = "OrRd" ) ht2 = netAnalysis_signalingRole_heatmap (object.list[[i + 1 ]], pattern = "all" , signaling = pathway.union, title = names (object.list)[i + 1 ], width = 5 , height = 6 , color.heatmap = "OrRd" ) draw (ht1 + ht2, ht_gap = unit ( 0.5 , "cm" )) 从配受体的角度画一画 气泡图 # sources.use指定了源细胞类型的编号，4表示选择编号为4的细胞类型作为信号源。
在气泡图中，源细胞是负责发送信号的细胞类型 # targets.use指定了目标细胞类型的编号，c(5:11) 表示选择编号为5到11的细胞类型作为信号的接收者 # comparison指定需要比较的两个数据集或实验条件。c(1,2)表示将会比较数据集或实验组1和实验组2中细胞通讯的差异 # angle.x 控制 X 轴标签的旋转角度。
在这里，设置为45度，目的是使X轴标签的文字更容易阅读，尤其是当标签较长时 netVisual_bubble (cellchat, sources.use = 4 , targets.use = c ( 5 : 11 ), comparison = c ( 1 , 2 ), angle.x = 45 ) # 我们可以识别一个数据集中与另一个数据集相比上调 (增加) 和下调 (减少) 的信号配体 - 受体对。
这可以通过在 netVisual_bubble函数中指定max.dataset和min.dataset来实现。信号增加意味着这些信号在一个数据集中比另一个数据集具有更高的通信概率 (强度)。
gg1 <- netVisual_bubble (cellchat, sources.use = 4 , targets.use = c ( 5 : 11 ), comparison = c ( 1 , 2 ), max.dataset = 2 , title.name = "Increased signaling in LS" , angle.x = 45 , remove.isolate = T) gg2 <- netVisual_bubble (cellchat, sources.use = 4 , targets.use = c ( 5 : 11 ), comparison = c ( 1 , 2 ), max.dataset = 1 , title.name = "Decreased signaling in LS" , angle.x = 45 , remove.isolate = T) gg1 + gg2 以上的计算依赖的都是细胞通讯的可能性(强度)，接下来我们将通过配受体对基因表达的角度进一步研究 pos.dataset = "LS" features.name = pos.dataset # 差异计算 # identifyOverExpressedGenes函数用于识别在LS组中过表达的基因 # group.dataset = "datasets"：指定用于比较的分组（如实验组、对照组等）。
这个值指的是 cellchat@meta$datasets 中的分组信息 # only.pos = FALSE：表示不仅仅考虑上调基因，还包括下调基因。默认是 FALSE，表示同时考虑上调和下调基因 # thresh.pc = 0.1：指定基因在该组中需要过表达的最小百分比。
如果某个基因在指定的实验组中过表达的细胞占比超过10%，则认为该基因被过表达 # thresh.fc = 0.1：指定基因在该组中的最小对数变化倍数（log fold change）。
如果基因的对数倍数变化大于 0.1，则认为该基因过表达 # thresh.p = 1：p 值的阈值，设置为 1 意味着不对 p 值进行过滤 cellchat <- identifyOverExpressedGenes (cellchat, group.dataset = "datasets" , pos.dataset = pos.dataset, features.name = features.name, only.pos = FALSE , thresh.pc = 0.1 , thresh.fc = 0.1 , thresh.p = 1 ) # 提取LS中上调的配受体对 # netMappingDEG 函数用于将差异表达基因（Differentially Expressed Genes, DEG）映射到细胞通讯网络上。
它会分析哪些差异表达基因参与了细胞间的信号通讯 net <- netMappingDEG (cellchat, features.name = features.name) # 提取LS组上调的配体 # ligand.logFC表示筛选出配体基因的对数倍数变化（logFC）大于等于 0.2 的信号通讯对，即筛选出上调的配体基因参与的信号通讯 net.up <- subsetCommunication (cellchat, net = net, datasets = "LS" , ligand.logFC = 0.2 , receptor.logFC = NULL ) # 提取LS组下调的配体基因和下调受体基因参与的信号通讯 net.down <- subsetCommunication (cellchat, net = net, datasets = "LS" , ligand.logFC = - 0.1 , receptor.logFC = - 0.1 ) # extractGeneSubsetFromPair 函数用于从细胞通讯对中提取相关的基因子集 gene.up <- extractGeneSubsetFromPair (net.up, cellchat) gene.down <- extractGeneSubsetFromPair (net.down, cellchat) # 可视化：# 气泡图 # 从 net.up 中提取与上调信号相关的配体-受体（ligand-receptor）对的名称（interaction_name） pairLR.use.up = net.up[, "interaction_name" , drop = F] gg1 <- netVisual_bubble (cellchat, pairLR.use = pairLR.use.up, sources.use = 4 , targets.use = c ( 5 : 11 ), comparison = c ( 1 , 2 ), angle.x = 45 , remove.isolate = T, title.name = paste0 ( "Up-regulated signaling in " , names (object.list)[ 2 ])) # 从 net.down 中提取下调的配体-受体对的名称（interaction_name） pairLR.use.down = net.down[, "interaction_name" , drop = F] gg2 <- netVisual_bubble (cellchat, pairLR.use = pairLR.use.down, sources.use = 4 , targets.use = c ( 5 : 11 ), comparison = c ( 1 , 2 ), angle.x = 45 , remove.isolate = T, title.name = paste0 ( "Down-regulated signaling in " , names (object.list)[ 2 ])) gg1 + gg2 # 弦图 # lab.cex = 0.8：标签字体大小 # small.gap = 3.5：每两个细胞群体之间的间隙大小，数值越大，间隙越明显 par ( mfrow = c ( 1 , 2 ), xpd= TRUE ) netVisual_chord_gene (object.list[[ 1 ]], sources.use = 4 , targets.use = c ( 5 : 11 ), slot.name = "net" , net = net.down, lab.cex = 0.8 , small.gap = 3.5 , title.name = paste0 ( "Down-regulated signaling in " , names (object.list)[ 1 ])) netVisual_chord_gene (object.list[[ 2 ]], sources.use = 4 , targets.use = c ( 5 : 11 ), slot.name = "net" , net = net.up, lab.cex = 0.8 , small.gap = 3.5 , title.name = paste0 ( "Up-regulated signaling in " , names (object.list)[ 2 ])) Sys.time # [1] "2025-05-15 11:15:10 CST" save.image ( "result_cellchat/cellchat.rdata" )