科研信息学R绘图trickR语言做图

几个最近作图喜欢用的版式

2021-01-11  本文已影响0人  一只烟酒僧

circlize的使用:https://jokergoo.github.io/circlize_book/book/index.html
做环形热图:https://zhuanlan.zhihu.com/p/136138642
做环形热图2:https://www.shenxt.info/post/r-circlize-study-2/
1、预设的theme

theme(axis.line = element_line(size = 1.1, linetype = "solid"), 
        axis.text.y = element_text(size = 13,face = "bold",colour = "black",margin = margin(0,5,0,40)),#margin调整y轴的text的位置,多用于text过长无法全部显示时
        axis.text.x = element_text(size = 15,face = "bold",colour = "black"), 
        axis.ticks = element_line(colour = "black"),
        axis.title = element_text(size = 12, face = "bold"),
        panel.grid.major= element_line(size = 0.5,color = "grey",linetype = 2), #画上辅助线,虚线
        panel.grid = element_blank(),
        panel.background = element_rect(size = 1,color = "black",fill = "white"),#当想在top和right处画上边框时可以使用
        strip.text = element_text(size = 13,color = "white",face = "bold"),#分页的字体调整
        strip.background = element_rect(fill=pal_aaas()(10)[5],color = "black",size=1),#分页的标签的背景调整
        #panel.grid.major = element_blank(),
        #panel.background = element_blank(),
        legend.title = element_text(size = 14, face = "bold"),
        legend.text = element_text(size = 11, face = "bold"), 
        legend.position = "right", 
        legend.direction = "vertical")

2、韦恩图的另类表示方式-----热图

######################################################## 
#-------------------------------------------------------
# Topic:韦恩图转热图
# Author:Wang Haiquan
# Date:Mon Jan 11 11:38:11 2021
# Mail:mg1835020@smail.nju.edu.cn
#-------------------------------------------------------
########################################################

library(pheatmap)
library(openxlsx)
library(reshape2)

xxx_DEG_down<-read.xlsx("xxx.xlsx",sheet=2)
xxx_DEG_up<-read.xlsx("xxx.xlsx",sheet=3)

xxx_DEG<-list(xxx_DEG_up=xxx_DEG_up,
                 xxx_DEG_down=xxx_DEG_down)
xxx_DEG_long<-lapply(xxx_DEG,function(x){
  a=melt(x,measure.vars=1:4,variable.name = "Stage",value.name = "gene")
  a=a[!is.na(a$gene),]
  return(a)
})
#发现同一组找到的差异基因有重复!这一步中去重
xxx_DEG_long<-lapply(xxx_DEG_long,function(x){
  x$is.duplicated<-ifelse(duplicated(paste(x$Stage,x$gene,sep = "-")),T,F)
  x<-x[x$is.duplicated==F,]
  x$Stage<-factor(x$Stage,levels = unique(x$Stage))
  x$is.duplicated=NULL
  return(x)
})
#转化为宽矩阵,并计算频数
xxx_DEG_width<-lapply(xxx_DEG_long,function(x){
  a=t(dcast(x,formula = Stage~gene,fun.aggregate = length))
  print(a[1,1:4])
  colnames(a)<-as.character(a[1,1:4,drop=T])
  a=a[-1,]
  b<-rownames(a)
  a<-apply(a,2,as.numeric)
  rownames(a)<-b
  a<-as.data.frame(a)
  return(a)
})
#制作上调的注释文件
xxx_DEG_up_rowanno<-data.frame(row.names = rownames(xxx_DEG_width$xxx_DEG_up),
                                  stage=apply(xxx_DEG_width$xxx_DEG_up,1,
                                              function(x){
                                                if(sum(x)==1){colnames(xxx_DEG_width$xxx_DEG_up)[which(x==1)]
                                                }else{
                                                  paste("rep_num",sum(x),sep = "=")
                                                }}))
xxx_DEG_up_rowanno$stage<-factor(xxx_DEG_up_rowanno$stage,levels = c("rep_num=3","rep_num=2","GO","FGO","MIO","MIIO"))
xxx_DEG_up_rowanno<-xxx_DEG_up_rowanno[order(xxx_DEG_up_rowanno$stage),,drop=F]
#上调热图
pheatmap(xxx_DEG_width$xxx_DEG_up[rownames(xxx_DEG_up_rowanno),],
         scale = "none",
         show_rownames = F,show_colnames = T,cluster_cols = F,cluster_rows = F,
         annotation_row = xxx_DEG_up_rowanno,
         color = c("grey","red"),legend = F,main = "xxx_DEG_up")
#制作下调的注释文件
xxx_DEG_down_rowanno<-data.frame(row.names = rownames(xxx_DEG_width$xxx_DEG_down),
                                    stage=apply(xxx_DEG_width$xxx_DEG_down,1,
                                                function(x){
                                                  if(sum(x)==1){colnames(xxx_DEG_width$xxx_DEG_down)[which(x==1)]
                                                  }else{
                                                    paste("rep_num",sum(x),sep = "=")
                                                  }}))
xxx_DEG_down_rowanno$stage<-factor(xxx_DEG_down_rowanno$stage,levels = c("rep_num=3","rep_num=2","GO","FGO","MIO","MIIO"))
xxx_DEG_down_rowanno<-xxx_DEG_down_rowanno[order(xxx_DEG_down_rowanno$stage),,drop=F]
#热图
pheatmap(xxx_DEG_width$xxx_DEG_down[rownames(xxx_DEG_down_rowanno),],
         scale = "none",
         show_rownames = F,show_colnames = T,cluster_cols = F,cluster_rows = F,
         annotation_row = xxx_DEG_down_rowanno,
         color = c("grey","blue"),legend = F,main = "xxx_DEG_down")

放上文章中的模板图

3、环形热图_1

mat<-as.matrix(t(apply(xxx[,rev(colnames(xxx))],1,scale)))
rownames(mat)<-rownames(xxx_mat)
col_fun = colorRamp2(breaks = c(-2, 0, 2), colors = c("blue", "white", "red"))
lgd = Legend(title = "expr", col_fun = col_fun)
circos.clear()
circos.par(gap.after = c(90),start.degree = 0)
circos.heatmap(mat,
               col = col_fun,
               track.height = 0.5,
               dend.side = "inside", 
               rownames.side = "outside",
               rownames.cex = 0.7,
               cluster = T,
               bg.lty = 1,bg.border = "black",bg.lwd = 2
               )
draw(lgd, x = unit(0.6, "npc"), y = unit(0.7, "npc"))
circos.clear()
放上文章中的模板图

4、环形热图_2

#使用原始绘图函数画环形图
#mat为经过了scale的表达矩阵,行为基因,列为样本。
mat_sub<-t(mat)
dend <-as.dendrogram(hclust(dist(t(mat_sub))))
n=3
dend <-dend %>% set("branches_k_color", k = n) 
par(mar=c(7.5,3,1,0))
plot(dend)
mat2 = mat_sub[, order.dendrogram(dend)]
lable1=row.names(mat2);lable1
lable2=colnames(mat2);lable2
circos.clear()
circos.par(canvas.xlim =c(-1.3,1.3),
           canvas.ylim = c(-1.3,1.3),
           cell.padding = c(0,0,0,0), 
           gap.degree =90)
factors = "a"
circos.initialize(factors, xlim = c(0, ncol(mat2)))
nr<-nrow(mat2);nc<-ncol(mat2);lable2=colnames(mat2);col_mat<-colorRamp2(c(-1.5, 0, 1.5), c("skyblue", "white", "red"))(mat2)
circos.track(ylim = c(0, nr),bg.border = NA,track.height = 0.02*nr,
             panel.fun = function(x, y) {
               for(i in 1:nr) {
                 circos.rect(xleft = 1:nc - 1, ybottom = rep(nr - i, nc),
                             xright = 1:nc, ytop = rep(nr - i + 1, nc),
                             border = "white",
                             col = col_mat[i,])
                 # circos.text(x = nc,
                 #             y = 26 -i,
                 #             labels = lable1[i],
                 #             facing = "downward", niceFacing = TRUE,
                 #             cex = 0.6,
                 #             adj = c(-0.2, 0))
               }
             })
for(i in 1:nc){
  circos.text(x = i-0.4,
              y = 27,
              labels = lable2[i],
              facing = "clockwise", niceFacing = TRUE,
              cex = 1,adj = c(0, 0))
}
max_height <-max(attr(dend, "height"))
circos.track(ylim = c(0, max_height),bg.border = NA,track.height = 0.3, 
             panel.fun = function(x, y){
               circos.dendrogram(dend = dend,
                                 max_height = max_height)
             })
#加上样品注释!
anno_df<-as.data.frame(table(factor(str_replace(rownames(mat2),"[0-9]",""),levels =unique(str_replace(rownames(mat2),"[0-9]","")) )))
anno_df$ytop=Reduce(sum,anno_df$Freq,accumulate = T)
anno_df$ybottom=anno_df$ytop-anno_df$Freq
anno_df$color=RColorBrewer::brewer.pal(8,"Set3")
anno_df$text_loc=(anno_df$ybottom+anno_df$ytop)/2

circos.track(track.index = 1, panel.fun = function(x, y) {
  if(CELL_META$sector.numeric.index == 1) { 
    for (i in 1:(dim(anno_df)[1])) {
      circos.rect(xleft = -2,
                  xright = 0,
                  ybottom = anno_df$ybottom[i],
                  ytop = anno_df$ytop[i],
                  col = anno_df$color[i], border = NA)
      circos.text(x=-1,y=anno_df$text_loc[i],anno_df$Var1[i],cex = 0.6,col = "black",facing = "outside")
    }
    
    
  }
}, bg.border = NA)
lgd <- Legend(at = c(-2,-1, 0, 1, 2), col_fun = col_fun, 
              title_position = "topcenter",title = "Z-score")
draw(lgd, x = unit(0.65, "npc"), y = unit(0.7, "npc"))
样式
上一篇 下一篇

猜你喜欢

热点阅读