NG图表复现｜气泡热图 + 连线图揭示跨细胞信号通路

论文信息 A multi-tissue single-cell expression atlas in cattle Han, B., Li, H., Zheng, W. et al. A multi-tissue single-cell expression atlas in cattle. Nat Genet (2025). https://doi.org/10.1038/s41588-025-02329-5 论文原图仿图图形解读这幅图展示了生发中心（GCs）与多种免疫细胞在至少四个肠段中共享的配体–受体互作网络：左侧气泡图通过圆圈大小和颜色分别表示分子在特定组织与细胞类型中的表达比例和平均水平，黑色圈边突出已识别的配对；

右侧连线示意了GCs作为信号源，通过关键分子（如GZMA、MIF、APP、CDH1等）与免疫细胞上的受体（如PARD3、ITGAE、CD44、CD74等）建立联系，揭示了GCs在跨细胞通讯和免疫调控中的核心作用。右侧的连线其实是这幅图的灵魂部分——它直观地展示了配体–受体的对应关系左边热图区域：上半部分是配体基因（Ligands，主要在 GCs 表达），下半部分是受体基因（Receptors，主要在免疫细胞上表达）。

右侧连线：每一条线就是一个配体–受体对，把左边上方的某个配体基因，与下方的对应受体基因连接起来。红色端点 → 配体（在 GCs 表达）蓝色端点 → 受体（在免疫细胞表达）意义：连线说明 GCs 通过某个配体基因，和免疫细胞上相应的受体基因发生分子层面的相互作用。比如：CDH1（配体） → CD44（受体）表明 GCs 可能通过 CDH1–CD44 通路与免疫细胞沟通；

APP → PARD3 表明 APP 蛋白可能参与调节免疫细胞的极性或黏附。换句话说，右侧连线就是在告诉读者：哪些分子对在不同细胞间起桥梁作用，从而建立跨细胞的通讯网络绘图思路这幅图的信息量非常大，整体难度较高，更适合进阶学习。从论文来看，作者是通过上下两幅气泡热图拼接实现的，但这种方式在与右侧的连线点图对齐时往往需要额外调整。为简化操作，这里建议将两幅气泡热图视为一个整体来绘制，再与右侧点线图拼接，这样更容易保证位置对应。

需要注意的是，热图右侧的基因标签存在重复，因此可先用序号替代，完成排版后再替换回真实的基因名。右侧的点线图则需要根据配体–受体对应关系构建数据集，并在拼图时利用 patchwork 包进行位置微调。此外，在整体气泡热图中间预留的留白区，可以通过在数据集中人为添加来实现。

加载R包 library (tidyverse) library (ggnewscale) library (patchwork) library (RColorBrewer) sessionInfo R version 4.5.0 (2025-04-11) Platform: aarch64-apple-darwin20 Running under: macOS Sequoia 15.5 Matrix products: default BLAS: /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRblas.0.dylib LAPACK: /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRlapack.dylib; LAPACK version 3.12.1 locale: [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8 time zone: Asia/Shanghai tzcode source: internal attached base packages: [1] stats graphics grDevices utils datasets methods base other attached packages: [1] RColorBrewer_1.1-3 patchwork_1.3.1 ggnewscale_0.5.1 lubridate_1.9.4 [5] forcats_1.0.0 stringr_1.5.1 dplyr_1.1.4 purrr_1.1.0 [9] readr_2.1.5 tidyr_1.3.1 tibble_3.3.0 ggplot2_3.5.2 [13] tidyverse_2.0.0 loaded via a namespace (and not attached): [1] gtable_0.3.6 jsonlite_2.0.0 compiler_4.5.0 tidyselect_1.2.1 [5] dichromat_2.0-0.1 scales_1.4.0 yaml_2.3.10 fastmap_1.2.0 [9] R6_2.6.1 generics_0.1.4 knitr_1.50 htmlwidgets_1.6.4 [13] pillar_1.11.0 tzdb_0.5.0 rlang_1.1.6 stringi_1.8.7 [17] xfun_0.53 timechange_0.3.0 cli_3.6.5 withr_3.0.2 [21] magrittr_2.0.3 digest_0.6.37 grid_4.5.0 rstudioapi_0.17.1 [25] hms_1.1.3 lifecycle_1.0.4 vctrs_0.6.5 evaluate_1.0.5 [29] glue_1.8.0 farver_2.1.2 rmarkdown_2.29 tools_4.5.0 [33] pkgconfig_2.0.3 htmltools_0.5.8.1 数据读取读入两份热图数据 df1 <- read_tsv ( "heatmap1.tsv" ) %>% pivot_longer ( - c (Gene,id)) %>% mutate ( Percent = runif ( n , 0 , 100 )) df2 <- read_tsv ( "heatmap2.tsv" ) %>% pivot_longer ( - c (Gene,id)) %>% mutate ( Percent = runif ( n , 0 , 100 )) %>% mutate ( value= as.character (value)) # 整合数据 dff <- df1 %>% bind_rows (df2) %>% mutate ( id= factor (id, levels = rev ( unique (id)))) dff $ name <- factor (dff $ name, levels = unique (dff $ name)) 气泡热图 p1 <- dff %>% ggplot (., aes (name,id)) + # 拆分数据添加气泡 geom_point ( data= dff %>% filter (id %in% as.character ( 14 : 32 )) %>% mutate ( value= as.numeric (value)), aes ( fill= value, size= Percent), pch= 21 ) + scale_fill_gradientn ( colours = rev ( colorRampPalette ( brewer.pal ( 11 , "RdBu" )[ 3 : 9 ])( 200 ))) + new_scale_fill + # 用于留白 geom_point ( data= dff %>% filter (id %in% as.character ( 13 )), aes ( fill= value), pch= 22 , size= 0 , stroke = 0 , show.legend = F) + new_scale_fill + geom_point ( data= dff %>% filter (id %in% as.character ( 1 : 12 )) %>% mutate ( value= as.numeric (value)), aes ( fill= value, size= Percent), pch= 21 , show.legend = F) + scale_fill_gradientn ( colours = rev ( colorRampPalette ( brewer.pal ( 11 , "RdBu" )[ 3 : 9 ])( 200 ))) + # 替换标签 scale_y_discrete ( label= rev ( c ( "GZMA" , "CD6" , "C5" , "MIF" , "ALCAM" , "SEMA4A" , "LGALS9" , "SEMA4D" , "GUCA2A" , "F11R" , "CDH1" , "APP" , "Tissues" , "PARD3" , "F2R" , "ALCAM" , "C5AR1" , "C3AR1" , "HAVCR2" , "CXCR4" , "CR2" , "ITGB7" , "ITGAE" , "ITGB2" , "ITGAL" , "CD6" , "CD44" , "PLXNB2" , "GUCY2C" , "F11R" , "CDH1" , "CD74" )), position = "right" ) + # 添加边框 geom_vline ( xintercept = c ( 0.5 , 20.5 )) + geom_hline ( yintercept = c ( 0.5 , 32.5 )) + theme_void + theme ( axis.text.y= element_text ( size= 9 , color= c ( rep ( "black" , 19 ), "white" , rep ( "black" , 12 ))), legend.background = element_blank , legend.position = "left" , panel.grid = element_line ( color= "grey90" )) 点线图 # 定义线段位点信息 df_curve <- data.frame ( x = 1.1 , xend = 1.1 , y = c ( 32 , 31 , 30 , 29 , 28 , 27 , 26 , 25 , 24 , 23 , 22 , 21 , 23 , 22 , 28 , 22 , 23 , 21 , 22 ), yend= c ( 19 , 18 , 17 , 16 , 15 , 14 , 13 , 12 , 11 , 10 , 9 , 8 , 7 , 6 , 5 , 4 , 3 , 2 , 1 )) p2 <- data.frame ( id= c ( 1 : 19 , 21 : 32 ), type= c ( rep ( "Target" , 19 ), rep ( "Source" , 12 )), x= "type" ) %>% ggplot (., aes ( x= x, y= id)) + geom_point ( pch= 21 , size= 4 , aes ( fill= type)) + # 添加曲线设置不同弯曲度 geom_curve ( data= df_curve %>% slice ( 1 : 6 ), aes ( x= x, xend= xend, y= y, yend= yend), inherit.aes = F, # 正值：向左弯；

负值：向右弯 curvature = - 0.5 , color= "grey60" , arrow = arrow ( length = unit ( 0.06 , "inches" ), type = "closed" )) + geom_curve ( data= df_curve %>% slice ( 7 : n ), aes ( x= x, xend= xend, y= y, yend= yend), inherit.aes = F, curvature = - 0.3 , color= "grey60" , arrow = arrow ( length = unit ( 0.06 , "inches" ), type = "closed" )) + # 添加垂直线段 geom_curve ( data= df_curve, aes ( x= 3 , xend= 3 , y= 28 , yend= 4 ), inherit.aes = F, curvature = 0 , color= " , arrow = arrow ( length = unit ( 0.1 , "inches" ), type = "closed" )) + annotate ( geom= "text" , x= 3 , y= 28.5 , label= "Source" , size= 4 ) + annotate ( geom= "text" , x= 3 , y= 3.5 , label= "Target" , size= 4 ) + scale_y_continuous ( expand= expansion ( mult = c ( 0.02 , 0.02 ))) + scale_fill_manual ( values = c ( " , " )) + coord_cartesian ( clip= 'off' ) + theme_void + theme ( legend.position = "none" , plot.margin = margin ( 0 , 1 , 0 , 0 , unit= "cm" )) 注释条带 p3 <- dff %>% filter (Gene == "Tissues" ) %>% dplyr :: rename ( "Cell type" = "value" ) %>% ggplot ( aes (name,Gene, fill= ` Cell type ` )) + geom_tile + scale_fill_manual ( values = c ( " , " , " , " )) + theme_void + theme ( legend.background = element_blank , legend.position = "left" , plot.margin = margin ( 0 , 0 , 0 , 0 , unit= "cm" )) 拼图 # 通过plot_spacer添加空白的方式来微调对齐 pp <- (p1 / p3) + plot_layout ( heights = c ( 1 , 0.05 )) + plot_layout ( guides = 'collect' ) & theme ( legend.position = 'left' ) pp2 <- (p2 / plot_spacer ) + plot_layout ( heights = c ( 1 , 0.04 )) (pp | pp2) + plot_layout ( widths = c ( 3 , 1 ))