R绘图技巧分享—绘制图形如何导出为可编辑的PPT格式？

 

点击上方

“科研后花园”

关注我们

代码如下：

1、先绘制主体图形—主要绘制四张图：

#设置工作环境
rm(list=ls())
setwd("D:/桌面/SCI论文写作与绘图/R语言绘图/绘图技巧/图形保存PPT")


####先绘制需要的图形
library(ggplot2) # Create Elegant Data Visualisations Using the Grammar of Graphics
library(reshape2) # Flexibly Reshape Data: A Reboot of the Reshape Package
library(tidyr) # Tidy Messy Data
library(dplyr) # A Grammar of Data Manipulation
library(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 <- ToothGrowth
df$dose <- as.factor(df$dose)
data <- df
df1 <- 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)
p

2、导出为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)
##导出PPT
pptx <- 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

温馨提示

如果你喜欢本文，请分享到朋友圈，想要获得更多信息，请关注我。