論文

Single-cell profiling of vascular endothelial cells reveals progressive organ-specific vulnerabilities during obesity

https://www.nature.com/articles/s42255-022-00674-x#Sec58

s42255-022-00674-x.pdf

https://github.com/Osynchronika/sc_EC_obesity_atlas

大部分 作圖的數(shù)據(jù)都有，可以試著用論文中提供的數(shù)據(jù)復(fù)現(xiàn)一下論文中的圖

今天的推文我們試著復(fù)現(xiàn)一下論文中的Figure2中的熱圖，figure2中有3個熱圖，按照復(fù)雜程度排序是 figure2m figure2f 和figure2o

image.png

image.png

image.png

今天的推文我們先復(fù)現(xiàn)figure2o

論文中提供的數(shù)據(jù)如下

image.png

數(shù)據(jù)中有很多缺失值，看論文中的配色 我猜是把缺失值替換成0了，我不太確定這種處理方式是否可以

加載要用到的R包

library(readxl)
library(tidyverse)
library(stringr)
library(ggtree)
library(ggh4x)

讀取數(shù)據(jù)

dat01<-read_excel("data/20230207/figure2o.xlsx",
                  sheet = "Sheet3",na="NA")
dat01

這里我把第一列的列名除了第一列修改成A01:A21，因為最上層的兩層分組需要人為構(gòu)造數(shù)據(jù)，列名修改成A01:A21在excel里好輸入些

colnames(dat01)<-c("gene_name",paste0("A",str_pad(1:21,2,side = "left",pad = "0")))

首先是做最左側(cè)的樹圖

因為有了樹圖后要根據(jù)樹圖的前后順序調(diào)整熱圖的y軸的順序

dat01  %>% 
  pivot_longer(!gene_name) %>% 
  mutate(value=replace_na(value,0)) %>% 
  pivot_wider() %>% 
  column_to_rownames("gene_name") %>% 
  dist() %>% 
  hclust() -> dat01.hclust

ggtree(dat01.hclust)+
  geom_tiplab()

y_levels<-c("Fabp5","Fabp4","Cd36","Fabp1","Dbi","Lpl")

ggtree(dat01.hclust) -> p2

p2

image.png

然后是熱圖的代碼

dat01 %>% 
  mutate(gene_name=factor(gene_name,
                          levels = y_levels )) %>% 
  pivot_longer(!gene_name) %>% 
  mutate(value=replace_na(value,0)) %>% 
  ggplot(aes(x=name,y=gene_name))+
  geom_tile(aes(fill=value),color="black")+
  scale_fill_gradient2(low="blue",mid="white",high = "red",
                       midpoint = 0,
                       breaks=c(-0.5,-0.25,0,0.25,0.5),
                       labels=c("<-0.5","",0,"",">0.5"))+
  scale_y_discrete(position = "right")+
  scale_x_discrete(expand = expansion(mult = c(0,0)))+
  theme_bw()+
  theme(legend.position = "bottom",
        axis.text.x = element_blank(),
        axis.text.y = element_text(face="italic"),
        axis.ticks = element_blank(),
        axis.title = element_blank(),
        panel.border = element_blank(),
        panel.grid = element_blank())+
  guides(fill=guide_colorbar(title.position = "top",
                             title.hjust = 0.5,
                             barwidth = 10)) -> p1
p1

image.png

最后是分組標(biāo)記的代碼

我人為構(gòu)造的數(shù)據(jù)如下

image.png

兩層的分組標(biāo)記：一層是熱圖，另外一層是分面的形式，分面的形式可以添加好多層

dat<-read_excel("data/20230207/figure2o.xlsx",
                sheet = "Sheet2")

dat %>% pull(group02) %>% unique()

dat %>% 
  mutate(group=factor(group02,levels = dat %>% pull(group02) %>% unique())) -> dat

strip.fill<-c("#ee716b","#c99e0d","#16b5ea","#5ab033","#37b28f","#a08ec3","#d96aa6")
ggplot(data=dat,aes(x=x,y=1))+
  geom_tile(aes(fill=group01),color="black")+
  geom_text(aes(label=group01),color="white")+
  facet_nested(.~group02,space = "free",scales = "free",
               strip=strip_nested(background_x = 
                                    elem_list_rect(fill=strip.fill,
                                                   by_layer_x=FALSE)))+
  scale_x_discrete(expand = expansion(mult = c(0,0)))+
  scale_y_discrete(expand = expansion(mult = c(0,0)))+
  scale_fill_manual(values = c("#dd0c1b","#48ad96","#4d6eb4"))+
  theme(panel.spacing = unit(0,"lines"),
        strip.background = element_rect(fill=c("white"),color="black"),
        axis.text = element_blank(),
        axis.title = element_blank(),
        axis.ticks = element_blank(),
        strip.text.x = element_text(margin = margin(0.5,0,0.5,0, "cm")),
        legend.position = "none",) -> p3

p3

image.png

這里遇到一個問題是

facet_nested(.~group02,space = "free",scales = "free",
               strip=strip_nested(background_x = 
                                    elem_list_rect(fill=strip.fill,
                                                   by_layer_x=FALSE)))

代碼里scales=free不能和coord_equal()組合使用，暫時不知道如何解決這個問題

最后是組合圖

library(patchwork)
(plot_spacer() + p3 + plot_layout(widths = c(1,8)))/(p2+p1+plot_layout(widths = c(1,8)))+
  plot_layout(heights = c(1,4))

最終結(jié)果如下

image.png

示例數(shù)據(jù)和代碼可以給推文點贊，然后點擊在看，最后留言獲取

歡迎大家關(guān)注我的公眾號

小明的數(shù)據(jù)分析筆記本

小明的數(shù)據(jù)分析筆記本 公眾號 主要分享：1、R語言和python做數(shù)據(jù)分析和數(shù)據(jù)可視化的簡單小例子；2、園藝植物相關(guān)轉(zhuǎn)錄組學(xué)、基因組學(xué)、群體遺傳學(xué)文獻閱讀筆記；3、生物信息學(xué)入門學(xué)習(xí)資料及自己的學(xué)習(xí)筆記！

微信公眾號好像又有改動，如果沒有將這個公眾號設(shè)為星標(biāo)的話，會經(jīng)常錯過公眾號的推文，個人建議將 小明的數(shù)據(jù)分析筆記本 公眾號添加星標(biāo)，添加方法是

點開公眾號的頁面，右上角有三個點

image.png

點擊三個點，會跳出界面

image.png

直接點擊 設(shè)為星標(biāo) 就可以了