论文原图
复现学习下这篇nature文章（米妮：仰望下张泽民院士课题组Nature新文章：跨组织的多细胞协调模块及其在癌症中的动态重塑）FIg4 C 图
复现图
此图在原文中的应用：显示了17个调节子（regulons）的细胞活动情况，这些调节子在不同细胞亚群中、不同年龄组中的表现（可以大体看出在年龄越高组表达越深）。
类似应用场景：比较不同分组不同年龄段的感兴趣基因（转录因子）表达。
生成模拟数据
####1\. 生成模拟数据 ####
library(tidyverse)
# 设置随机种子以确保结果可重复
set.seed(123)
# 创建 Regulon 和 Subset 的组合
#regulons <- paste0("Regulon", 1:17)
regulons <- c(
"NFKB1(+)", "NFKB2(+)", "KLF6(+)", "KLF2(+)", "JUND(+)", "JUNB(+)", "JUN(+)",
"FOSB(+)", "FOS(+)", "ETS1(+)", "ELF1(+)", "CREM(+)", "CHD1(+)", "BCLAF1(+)",
"ATF3(+)", "RELB(+)", "NR3C1(+)"
)
#subsets <- paste0("Subset", 1:4)
subsets <- c("B03", "B05", "CD4T03", "I06")
#cell_subsets <- paste0("Cell_subset", 1:5)
cell_subsets <- age_groups <- c("<35", "40-49", "50-59", "60-69", "70-85")
# 创建数据框
df <- expand.grid(Regulon = regulons, Subset = subsets)
# 添加数值列
for (cell_subset in cell_subsets) {
df[[cell_subset]] <- runif(nrow(df), min = 0, max = 0.5)
}
# 查看数据框
head(df)
# 将数据框保存为 TSV 文件
write_tsv(df, "data.tsv")
读入数据
library(tidyverse)
library(ggnewscale)
library(geomtextpath)
library(RColorBrewer)
library(magrittr)
library(circlize)
#### 2\. 读入数据 ####
df <- read_tsv("data.tsv") %>%
pivot_longer(-c("Regulon","Subset")) %>%
separate(col=Subset,into ="Cell subset",sep ="_",remove =F) %>%
mutate(group="Subset") %>% arrange(Regulon,Subset) %>%
group_by(name) %>%
mutate(id=row_number())
df$Regulon <- factor(df$Regulon,df$Regulon %>% unique())
df$name <- factor(df$name,levels = rev(df$name %>% unique()))
df_x <- unique(df$Regulon) %>%
as.data.frame() %>%
mutate(y = seq(from =2.5, by =4, length.out = n())) %>%
set_colnames(c("Regulon","x"))
画图
####3\. 画图 ####
ggplot(df,aes(id,name,fill=value)) +
geom_tile() +
scale_fill_gradientn(
colours = colorRampPalette(brewer.pal(9,"Blues")[2:9])(100),
na.value ="grey80",
limits = c(0,0.5),
breaks = c(0,0.5),
labels = c("Min","Max"),
name ="Activity",
guide = guide_colorbar(
direction ="horizontal",
title.position ="top",
title.hjust =0.5,
barwidth = unit(3,"cm"),
barheight = unit(0.5,"cm"),
label.position ="bottom",
label.hjust = c(1,0),
label.vjust =10)) +
new_scale_fill()+
geom_tile(aes(id,group,fill=`Cell subset`),inherit.aes =F)+
scale_fill_manual(values=c("#7294D4","#DD8D29","#81A88D","#E6A0C4")) +
geom_textpath(data=df_x,aes(x=x,label = Regulon,y =7.5),
size=3,
vjust=0.5,hjust=0.5,inherit.aes =F,color="black") +
geom_text(x=0.5,y=-10,label="Cellular activity of\nconvergent regulons\nin CM05",
inherit.aes =F,vjust=0.5,size.unit ="pt",
size=12,color="black") +
coord_radial(start =0, end =1.9*pi,inner.radius =0.6,clip="off")+
scale_y_discrete(expand = c(0,0),position ="left") +
scale_x_continuous(expand = c(0,0)) +
labs(x=NULL,y=NULL) +
theme(axis.text.y=element_text(color=c(rep("black",5),"white"),
size=8,hjust=0),
axis.text.x=element_blank(),
plot.background = element_blank(),
panel.background = element_blank(),
panel.grid.minor = element_blank(),
panel.grid.major =element_blank(),
axis.ticks = element_blank(),
plot.margin = margin(0,0.6,0,0,unit ="cm"))
运行以上结果可以得到此图：
运行结果
R. sessionInfo
> sessionInfo()
R version 4.3.3 (2024-02-29)
Platform: x86_64-apple-darwin20 (64-bit)
Running under: macOS 15.4.1
Matrix products: default
BLAS: /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRlapack.dylib; LAPACK version 3.11.0
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
[5] datasets methods base
other attached packages:
[1] circlize_0.4.16 magrittr_2.0.3
[3] RColorBrewer_1.1-3 geomtextpath_0.1.5
[5] ggnewscale_0.5.0 lubridate_1.9.3
[7] forcats_1.0.0 stringr_1.5.1
[9] dplyr_1.1.4 purrr_1.0.2
[11] readr_2.1.5 tidyr_1.3.1
[13] tibble_3.2.1 ggplot2_3.5.2
[15] tidyverse_2.0.0
loaded via a namespace (and not attached):
[1] bit_4.5.0 gtable_0.3.6
[3] crayon_1.5.3 compiler_4.3.3
[5] tidyselect_1.2.1 parallel_4.3.3
[7] systemfonts_1.1.0 scales_1.3.0
[9] textshaping_0.4.0 R6_2.5.1
[11] labeling_0.4.3 generics_0.1.3
[13] shape_1.4.6.1 munsell_0.5.1
[15] pillar_1.9.0 tzdb_0.4.0
[17] rlang_1.1.4 utf8_1.2.4
[19] stringi_1.8.4 GlobalOptions_0.1.2
[21] bit64_4.5.2 timechange_0.3.0
[23] cli_3.6.3 withr_3.0.2
[25] grid_4.3.3 vroom_1.6.5
[27] rstudioapi_0.17.1 hms_1.1.3
[29] lifecycle_1.0.4 vctrs_0.6.5
[31] glue_1.8.0 farver_2.1.2
[33] fansi_1.0.6 colorspace_2.1-1
[35] tools_4.3.3 pkgconfig_2.0.3
