使用函数导出到powerpoint以创建图形

时间:2016-04-03 15:20:32

标签: r ggplot2 powerpoint

我目前正在尝试将多个图形导出到R中的相同Powerpoint演示文稿中。使用函数创建多个图形。 但是,当我运行下面的代码时,它为每个变量生成一个单独的Powerpoint(我希望它们在Calc_Commissiona和CalcCommission_Perc的每个变量中相同),Age_Banded,InstalmentsRequestedInd和NetPrem_Banded。这是因为ggsave只是看着我假设的最后一个情节。 有任何想法吗? 此外,CreateGraph函数只是为CalcCommission Perc生成图形。当另一个被删除时,CalcCommission和CalcCommission_Perc都独立工作......

require(ggplot2)

require(RDCOMClient)

require(R2PPT)

date <- "20160401"


CalcCommission  <- function(Variable,FName,AxisAngle){

    Actual_Commission <- tapply(Converted_A$Commission,Converted_A[Variable],mean)
  Predicted_Commission <- tapply(Final_cut$Commission_Response*Final_cut$Origination.Demand,Final_cut[Variable],sum)/tapply(Final_cut$Origination.Demand,Final_cut[Variable],sum)/100

Data <- data.frame(x=names(Actual_Commission),Actual_Commission,Predicted_Commission)
   Commission_Plot <- ggplot(Data,aes(x=seq(length(unique(x))))) +
    geom_line(aes(y=Actual_Commission, colour = "Actual Commission")) + 
    geom_line(aes(y=Predicted_Commission, colour = "Predicted Commission")) +
    scale_x_continuous(name = FName, 
                       breaks = seq(length(unique(Data$x))), 
                       labels = unique(Data$x))   +
    scale_y_continuous(name = "Commission £") +
    ggtitle("Commission £") +
    theme(legend.title=element_blank(),axis.text.x = element_text(angle = AxisAngle, hjust = 1))

  mypres <- PPT.Init(method="RDCOMClient")
  mypres<-PPT.AddTitleSlide(mypres,title="Commission £",subtitle=date)

  ggsave(my_temp_file<-paste(tempfile(),".wmf",sep=""), plot=Commission_Plot)
  mypres <- PPT.AddBlankSlide(mypres)
  mypres <- PPT.AddGraphicstoSlide(mypres,file=my_temp_file)
  unlink(my_temp_file) 

}

CalcCommission_Perc  <- function(Variable,FName,AxisAngle){
  Actual_Commission_Perc <- tapply((Converted_A$Commission/Converted_A$NetPremium)*100,Converted_A[Variable],mean)

Predicted_Commission_Perc <- (((tapply(Final_cut$Commission_Response*Final_cut$Origination.Demand,Final_cut[Variable],sum)/tapply(Final_cut$Origination.Demand,Final_cut[Variable],sum))/100)/
                                  (tapply(Final_cut$Prem_Net*Final_cut$Origination.Demand,Final_cut[Variable],sum)/tapply(Final_cut$Origination.Demand,Final_cut[Variable],sum)))*100

Data <- data.frame(x=names(Actual_Commission_Perc),Actual_Commission_Perc,Predicted_Commission_Perc)

  Commission_Perc_Plot <- ggplot(Data,aes(x=seq(length(unique(x))))) +
    geom_line(aes(y=Actual_Commission_Perc, colour = "Actual Commission %")) + 
    geom_line(aes(y=Predicted_Commission_Perc, colour = "Predicted Commission %")) +
    scale_x_continuous(name = FName, 
                       breaks = seq(length(unique(Data$x))), 
                       labels = unique(Data$x))   +
    scale_y_continuous(name = "Commission £") +
    ggtitle("Commission %") +
    theme(legend.title=element_blank(),axis.text.x = element_text(angle = AxisAngle, hjust = 1))

  mypres <- PPT.Init(method="RDCOMClient")
  mypres<-PPT.AddTitleSlide(mypres,title="Commission %",subtitle=date)

  ggsave(my_temp_file<-paste(tempfile(),".wmf",sep=""), plot=Commission_Perc_Plot)
  mypres <- PPT.AddBlankSlide(mypres)
  mypres <- PPT.AddGraphicstoSlide(mypres,file=my_temp_file)
  unlink(my_temp_file) 
  }

CreateGraph  <- function(Variable,FName,AxisAngle){

  CalcCommission(Variable,FName,AxisAngle)
  CalcCommission_Perc(Variable,FName,AxisAngle)
  }
CreateGraph("Age_Banded","Age",0)
CreateGraph("InstalmentsRequestedInd","DD Payment",0)
CreateGraph("NetPrem_Banded","Net Premium",45)

2 个答案:

答案 0 :(得分:2)

这是在一个pptx文件中保存两个图的一种方法:

library(ReporteRs)
library(ggplot2)
library(magrittr)
pptx() %>%
  addSlide("Title and Content") %>% 
  addTitle("plot #1") %>% 
  addPlot(function() barplot( 1:8, col = 1:8 )) %>% 
  addSlide("Title and Content") %>% 
  addTitle("plot #2") %>% 
  addPlot(fun = print, x = qplot(Sepal.Length, Petal.Length, data = iris, color = Species, size = Petal.Width, alpha = I(0.7) )) %>%
  writeDoc(ppfn <<- tempfile(fileext = ".pptx"))

ppfn包含PowerPoint文件名,包括其路径。查看软件包文档here

答案 1 :(得分:0)

由于ReporteRs已从CRAN中删除并由officer取代,因此以上答案已过时。我刚刚制作了一个基于officer的新程序包导出功能,该程序包可以很容易地使用graph2ppt()命令和append=TRUE选项,例如将多个图形导出到单个Powerpoint演示文稿中。制作包含2张幻灯片的演示文稿:

install.packages("export")
library(export)
library(ggplot2)
qplot(Sepal.Length, Petal.Length, data = iris, color = Species, 
      size = Petal.Width, alpha = I(0.7))     
graph2ppt(file="plots.pptx", width=6, height=5) 
qplot(Sepal.Width, Petal.Length, data = iris, color = Species, 
      size = Petal.Width, alpha = I(0.7))     
graph2ppt(file="plots.pptx", width=6, height=5, append=TRUE)