重复单细胞it-ChIP文章小图

Tips:

最近看单细胞ChIP-seq 文章一个图，本来作者用base plot 画的，因此尝试用ggplot2 画出base plot 风格。

image.png

图表达意思：在小鼠胚胎发育过程里，ESC状态逐渐退化，Meso 细胞系出现比较迟缓，也就是图b1从右往左变化过程中，拟合曲线先缓慢变化，后面再加速变化.

用ggplot2 画出类似效果（颜色未调整）

测试数据如下：

image.png
测试数据下载：
链接: https://pan.baidu.com/s/1MU1NJzA0V9KLsZabY4qrBA
提取码: rvxd

ggplot2 画图

########################
## time : 2020年3月23日23:49:50
## author : caokai
## email : 1692679247@qq.com
## aim ： plot fig4b
########################
rm(list=ls())
options(warn = -1)
options(stringsAsFactors = F)
setwd("C:/Users/16926/Desktop/2020-1/单细胞/sc-ChIP")


##############
## 1.加载包,读取xlsx(最新格式)
## 参考：
## 1.不同R包比较 https://www.jianshu.com/p/5ed6e4b5d181
## 2.openxlsx::read.xlsx 参数介绍 ：https://blog.csdn.net/zyunnketsu/article/details/78053179
##############
library(openxlsx)
library(ggplot2)
library(pacman)
library(grid)  


## 如何修改画图使用的字体 : https://www.jianshu.com/p/466ddc677a94
if (!requireNamespace("extrafont", quietly = TRUE)){
    install.packages("extrafont", dependencies=TRUE)}
library(extrafont)
# or
p_load(extrafont)
## 导入字体
font_import()
## 查看字体
loadfonts(device="win")  #Register fonts for Windows bitmap output
#device参数   The output device. Can be "pdf" (the default), "postscript", or "win".



##############
## 2.加载数据画图
##############


## x,y,z 是读取excel 的表格参数
plot_ESC_layer <- function(m){
  x=m[1] #"1";
  y=m[2] # "2";
  z=m[3] # "3";
  Name=m[4] # "Meso score"
  dat1  <-read.xlsx("41556_2019_383_MOESM9_ESM.xlsx",
                   sheet=6,startRow = 2,
                   cols=c(as.numeric(x),as.numeric(y),as.numeric(z))) #文件名+sheet的序号，简单粗暴
  
  head(dat1)
  p <- ggplot(dat1,aes(`y-axis`,`x-axis`))+
    ##  添加拟合曲线：https://zhuanlan.zhihu.com/p/27342288
    ## 不同的拟合方法
    geom_point(aes(col=cell.type))+
    geom_smooth(dat1,mapping = aes(`y-axis`,`x-axis`),se=FALSE,color="black",size=1.5)+
    
    ## 
    ## 修改点颜色
    # scale_color_manual(values = c("ESC"="#EB008B",
    #                               "ESC-Meso-Endo"="#FFDB00",
    #                               "Meso-Ecto"="#B600FF",
    #                               "Meso"="#0092FF"))+
    
    
    ## 修改横坐标， 加箭头 ： https://www.jianshu.com/p/d6d90ee510be
    ## 王诗翔 https://www.jianshu.com/p/03255dd4324d
    scale_x_continuous(name="ESC score",
                       limits = c(-2.2,4), # 加入只设定下边界limits=c(-2,NA)
                       expand = c(0,0),
                       breaks=c(-1.7,3.7),
                       labels = c("Low","High")) +
    theme(axis.ticks.x = element_blank())+
    annotate("segment", 
             x=4, xend=-1.8, 
             y=-2.2, yend=-2.2, 
             color="black", size=0.5, 
             arrow=arrow(angle = 10, length = unit(0.3, "inches"),
                         ends = "last", type = "closed"))+
    
    ## 修改纵坐标,线条
    ## 增加刻度长度 https://stackoverflow.com/questions/41251330/r-ggplot2-how-to-set-ticks-size/41251643#41251643?newreg=e8c2e01789194ac59dc5818e1dba8b27
    scale_y_continuous(name=Name, # name="Meso score"
                       breaks = seq(-2,4,1)) +
    annotate("segment",
             x=-2.2, xend=-2.2, 
             y=-2, yend=4, 
             color="black", size=1.5)+
    theme(axis.line.y=element_blank(),
          axis.ticks.length.y = unit(.15, "cm"),
          axis.ticks.y = element_line(size=1,color="black",
                                      linetype = 1,lineend="square"))
  
  
  
  
  ## 图例为透明 fill
  ## 图例排列 : 调整为plot左下方
  ## https://www.omicsclass.com/article/428  ；https://www.thinbug.com/q/35465836
  ## 如何调整图例点的大小
  ## https://stackoom.com/question/1Nf7j/%E5%A6%82%E4%BD%95%E5%A2%9E%E5%8A%A0ggplot-%E5%9B%BE%E4%BE%8B%E4%B8%AD%E7%82%B9%E7%9A%84%E5%A4%A7%E5%B0%8F
  
  p <- p +  guides(colour = guide_legend(override.aes = list(size=4),
                                         ncol=1))+
    
    ## 修改图例
    theme(legend.position = "bottom",
          legend.justification=c(0,1),
          legend.title = element_blank(),
          legend.key =element_rect(fill='transparent'),
          # legend.key.size = unit(1,"cm"), # 改变了行高
          legend.text = element_text(size=12))+
    
    ## 修改背景色，和网格
    theme(panel.grid.major =element_blank(),
          panel.grid.minor = element_blank(),
          panel.background = element_blank(),
          axis.line = element_line(colour = "black"),
          axis.line.x = element_blank(),
          axis.ticks.x = element_blank(),
          axis.title.x=element_text(size=16,color="black",hjust=0.5,face="bold"),
          axis.title.y=element_text(size=16,color="black",hjust=0.5,angle=90),
          axis.text.x=element_text(family="myFont",size=12,color="black") 
    )
  
  p
}

### 绘制plist 

data <-list("Meso"=c("1","2","3","Meso score"),
            "Endo"=c("5","6","7","Endo score"),
            "Ecto"=c("9","10","11","Ecto score"))

plot_ESC_layer(data$Meso)
plot_ESC_layer(data$Endo)
plot_ESC_layer(data$Ecto)

结果展示：

image.png

思考：

画出base plot 风格，主要纵坐标不太一样，于是去掉ggplot2 射线，添加一个线段，看起来像一点
拟合曲线：了解了lasso;loess/lowess ，多项式回归，样条等概念
本来可以直接用lapply 循环画出三个图，并进行拼接，但是拟合曲线，不太对。
geom_smooth(dat1,mapping = aes(y-axis,x-axis),se=FALSE,color="black",size=1.5)
Meso 需要按照mapping = aes(x-axis，y-axis)；
Ecto;Endo 需要按照 mapping = aes(y-axis,x-axis) 进行拟合，不太清楚原因~

### 拼图
library(cowplot)
plist <- lapply(data, plot_ESC_layer)

plot_grid(plotlist = plist,nrow = 1)

image.png

欢迎批评指正~