其他
R绘图技巧分享—绘制图形如何导出为可编辑的PPT格式？
点击上方
“科研后花园”
关注我们
代码如下：
1、先绘制主体图形—主要绘制四张图：
#设置工作环境rm(list=ls())setwd("D:/桌面/SCI论文写作与绘图/R语言绘图/绘图技巧/图形保存PPT")
####先绘制需要的图形library(ggplot2) # Create Elegant Data Visualisations Using the Grammar of Graphicslibrary(reshape2) # Flexibly Reshape Data: A Reboot of the Reshape Packagelibrary(tidyr) # Tidy Messy Datalibrary(dplyr) # A Grammar of Data Manipulationlibrary(ggsignif) # Significance Brackets for 'ggplot2'library(ggrepel) # Automatically Position Non-Overlapping Text Labels with'library(ggpmisc) # Miscellaneous Extensions to 'ggplot2'library(RColorBrewer) # ColorBrewer Palettes###第一幅图df <- ToothGrowthdf$dose <- as.factor(df$dose)data <- dfdf1 <- data%>% group_by(dose)%>% summarise(mean= mean(len), sd= sd(len))p1 <- ggplot()+ geom_bar(df1,mapping=aes(x=dose,y=mean), fill = "white", size = 1.5,color = c("#d20962","#f47721","#7ac143"),position="dodge", stat="identity",width = 0.6)+ geom_errorbar(df1,mapping=aes(x = dose,ymin = mean-sd, ymax = mean+sd), width = 0.3,color = c("#d20962","#f47721","#7ac143"), size=1.5)+ geom_jitter(df, mapping=aes(x=dose,y=len,fill = dose,color = dose,shape = dose), size = 2.5,width = 0.2,alpha=0.9)+ geom_line(df1,mapping=aes(x=dose,y=mean,group=1), size=1,color="#00aee6")+ geom_point(df1,mapping=aes(x=dose,y=mean),color="black",size=3,shape=8)+ scale_color_manual(values = c("#d20962","#f47721","#7ac143"))+ geom_signif(df,mapping=aes(x=dose,y=len), comparisons = list(c("0.5", "1"), c("1","2"), c("0.5","2")), map_signif_level=T, tip_length=c(0,0,0,0,0,0), y_position = c(35,40,45), test = "t.test")+ scale_y_continuous(expand = c(0, 0), limit = c(0, 50))+ theme_bw()+ theme(axis.text=element_text(color='black',size=12), axis.title.y = element_text(color='black',size=12), legend.text = element_text(color='black',size=12), legend.title = element_blank(), legend.position = "right")####第二幅图#读取数据df <- read.table(file="data1.txt",sep="\t",header=T,check.names=FALSE,row.names = 1)df$Tax=rownames(df)df1=melt(df)colnames(df1)=c("Tax","Samples","value")col <- colorRampPalette(brewer.pal(12,"Paired"))(11)p2 <- ggplot()+ geom_point(df1,mapping = aes(x = Samples, y = Tax, size = value, fill=Samples),shape=21)+ scale_fill_manual(values = col)+ scale_size_continuous(range = c(0, 10))+ theme(panel.background = element_blank(), legend.key = element_blank(), axis.text = element_text(color = "black",size = 10), panel.grid.major = element_line(color = "gray"),#网格线条颜色 panel.border = element_rect(color="black",fill=NA))+#边框色 labs(x=NULL,y=NULL)###第三幅图df <- read.table(file="data2.txt",sep="\t",header=T,check.names=FALSE)col<-c("#be0027", "#cf8d2e")p3 <- ggplot(df,aes(x,y,fill=group))+ geom_point(shape=21,size=3,alpha=0.5)+ geom_smooth(method = "lm",aes(color=group), se=T, formula = y ~ x, linetype=1,alpha=0.5)+ stat_poly_eq(formula = y ~ x, aes(color=group,label = paste(after_stat(eq.label), after_stat(rr.label),sep = "~~~")), parse = TRUE) + scale_fill_manual(values = col)+ scale_color_manual(values = col)+ theme_bw()+ theme(panel.grid=element_blank(), axis.text=element_text(color='#333c41',size=12), legend.text = element_text(color='#333c41',size=12), legend.title = element_blank())+ labs(x=NULL,y=NULL)###第四幅图df <- read.table(file="data3.txt",sep="\t",header=T,check.names=FALSE)df$group<-as.factor(ifelse(df$pvalue < 0.05 & abs(df$log2FoldChange) >= 2, ifelse(df$log2FoldChange>= 2 ,'up','down'),'NS'))df$label<-ifelse(df$pvalue<0.05&abs(df$log2FoldChange)>=4,"Y","N")df$label<-ifelse(df$label == 'Y', as.character(df$gene), '')p4 <- ggplot(df, aes(log2FoldChange, -log10(pvalue),fill = group)) + geom_point(color="black",alpha=0.6, size=3,shape=21)+ theme_bw()+ theme(axis.text=element_text(color='black',size=12), legend.text = element_text(color='black',size=12), legend.title = element_blank(), axis.title= element_text(size=12))+ geom_vline(xintercept = c(-2, 2), lty=3,color = 'black', lwd=0.8) + geom_vline(xintercept = c(-4, 4), lty=3,color = 'red', lwd=0.8)+ geom_hline(yintercept = -log10(0.05), lty=3,color = 'black', lwd=0.8) + scale_fill_manual(values = c('blue','grey','red'))+ labs(title="volcanoplot", x = 'log2 fold change', y = '-log10 pvalue')#拼图p <- cowplot::plot_grid(p1,p2,p3,p4,ncol = 2)p2、导出为PPT——提供两种方式：
1）结合officer和rvg包导出，整体思路就是先将绘制的图形转化为矢量格式，然后将其放到一个新生成的PPT文件中，多张图片可在同一PPT文件不同页面写入，是可编辑的，但是这种导出方式小编没搞明白怎么控制输出图片的长宽
# install.packages(c('officer', 'rvg','mschart'))library(officer)library(rvg)#将图形对象转化成可编辑的对象p1 <- dml(ggobj = p1)p2 <- dml(ggobj = p2)p3 <- dml(ggobj = p3)p4 <- dml(ggobj = p4)##导出PPTpptx <- read_pptx()#打开PPT#添加第一页pptx <- add_slide(pptx)ph_with(pptx, value = p1,location = ph_location_type())#导入图片#添加第二页pptx <- add_slide(pptx)ph_with(pptx, value = p2,location = ph_location_fullsize())#添加第三页pptx <- add_slide(pptx)ph_with(pptx, value = p3,location = ph_location_fullsize())#添加第四页pptx <- add_slide(pptx)ph_with(pptx, value = p4,location = ph_location_fullsize())print(pptx, 'test.pptx')
####拼图后导出p <- dml(ggobj = p)pptx <- read_pptx()#打开PPT#添加第一页pptx <- add_slide(pptx)ph_with(pptx, value = p,location = ph_location_type())#导入图片print(pptx, 'test2.pptx')2）export包导出：可编辑、可控制长宽，但是貌似只能将单个图形导出到一个文件中（包括 PPT 或 Word 文档），如果需要将多个图形导出到不同的文件中，则需要多次调用 graph2office 函数来实现。总体而言，这种方式小编推荐使用
#install.packages("export")library(export)graph2office(x=p1,file="p1", type = c("PPT"), width = 5,height = 4)PS: 以上内容是小编个人学习代码笔记分享，仅供参考学习，欢迎大家一起交流学习。
参考：
1）https://www.jianshu.com/p/8f2d4a92214c
2）https://zhuanlan.zhihu.com/p/612199402
温馨提示
如果你喜欢本文，请分享到朋友圈，想要获得更多信息，请关注我。