R/save_mpgm.R

In exoplanetX/greyforecasting: A package for grey systems forecasting methods

#'
#'
save_mpgm <- function(md,path="~/",filename=NULL){
  #md=gm
  require(xlsx)
  if(length(md$test)>0){
    original=md$data
  }else{
    original=c(md$data,md$test)
  }
  origin=md$data
  fit=c(md$fitted,md$forecasts)
  nm=names(fit)
  n=length(fit)
  #--存储表
  dt=data.frame(
    id=rep(NA,n),
    label=rep('outsample',n),
    original=rep(NA,n),
    fitting=rep(NA,n),
    errors=rep(NA,n),
    ape=rep(NA,n),
    insample=rep(NA,n),
    outsample=rep(NA,n),
    a=rep(NA,n),
    b=rep(NA,n),
    ax=rep(NA,n),
    w=rep(NA,n)
  )
  #--存储赋值
  dt$id=as.numeric(nm)
  dt$label[1:length(origin)]=rep('insample',length(origin))
  dt$original[1:length(original)]=original
  dt$fitting=fit
  dt$errors[1:length(origin)]=origin-md$fitted
  if(length(md$test)>0) dt$errors[(length(origin)+1):n]=md$test-fit[(length(origin)+1):n]
  dt$ape[1:length(origin)]=ape(origin,md$fitted)
  if(length(md$test)>0) dt$ape[(length(origin)+1):n]=ape(md$test,md$forecasts)
  dt$insample[1]=md$mape.in
  dt$outsample[1]=md$mape.out
  dt$a[1:2]=md$parameter$a
  dt$b[1:2]=md$parameter$b
  dt$w[1]=md$method$w
  dt$w[2]=-md$method$w
  #--输出文件
  if(!is.null(filename)){
    savename=paste("results","-",filename,".xlsx")
  }else{
    savename="results.xlsx"
  }
  filepath=paste(path,savename)
  write.xlsx(dt,file = filepath,row.names = F,sheetName="Sheet1",showNA = F)
}