學習復現下張澤民院士最新Nature文章圖-極坐標熱圖

論文原圖

復現學習下這篇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 
?著作權歸作者所有,轉載或內容合作請聯系作者
平臺聲明:文章內容(如有圖片或視頻亦包括在內)由作者上傳并發布,文章內容僅代表作者本人觀點,簡書系信息發布平臺,僅提供信息存儲服務。

推薦閱讀更多精彩內容