Tips:
最近看单细胞ChIP-seq 文章一个图,本来作者用base plot 画的,因此尝试用ggplot2 画出base plot 风格。
图表达意思:在小鼠胚胎发育过程里,ESC状态逐渐退化,Meso 细胞系出现比较迟缓,也就是图b1从右往左变化过程中,拟合曲线先缓慢变化,后面再加速变化.
用ggplot2 画出类似效果(颜色未调整)
-
测试数据如下:
测试数据下载:
链接: https://pan.baidu.com/s/1MU1NJzA0V9KLsZabY4qrBA
提取码: rvxd
- ggplot2 画图
########################
## time : 2020年3月23日23:49:50
## author : caokai
## email : [email protected]
## 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)
- 结果展示:
思考:
- 画出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)
欢迎批评指正~