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

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"))
样式
最后编辑于
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 158,736评论 4 362
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 67,167评论 1 291
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 108,442评论 0 243
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 43,902评论 0 204
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 52,302评论 3 287
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 40,573评论 1 216
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 31,847评论 2 312
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 30,562评论 0 197
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 34,260评论 1 241
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 30,531评论 2 245
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 32,021评论 1 258
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 28,367评论 2 253
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 33,016评论 3 235
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 26,068评论 0 8
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 26,827评论 0 194
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 35,610评论 2 274
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 35,514评论 2 269

推荐阅读更多精彩内容

  • 作者:严涛浙江大学作物遗传育种在读研究生(生物信息学方向)伪码农,R语言爱好者,爱开源 ggplot2学习笔记之图...
    wanghaihua888阅读 2,492评论 0 6
  • A ggplot2 Tutorial for Beautiful Plotting in R 原文见https:/...
    iColors阅读 2,529评论 0 15
  • R统计和作图 来自生信宝典 在R中赞扬下努力工作的你,奖励一份CheatShet 别人的电子书,你的电子书,都在b...
    天涯清水阅读 571评论 0 3
  • 定义借助视觉的表达方式,将数据用有趣、浅显、直观形式去传达给观众的一种手段。生成物是信息图标,由信息和图形组成(I...
    日暮山主人阅读 1,293评论 0 1
  • 推荐指数: 6.0 书籍主旨关键词:特权、焦点、注意力、语言联想、情景联想 观点: 1.统计学现在叫数据分析,社会...
    Jenaral阅读 5,661评论 0 5