R/post_calc_sh.R

#' Post linear-model caculation function
#'
#' A function to calucate things after Bayesian shrinkage.
#'
#' @param data a data.table class dataset for perdiction.
#' @param shrink a list from baysian_sh output.
#' @param date.start a character of modeling start date in "MM-DD-YYYY".
#' @param date.end a character of modeling start date in "MM-DD-YYYY".
#' @param var.group a data.table with variable group info.
#' @param date.group a data.table with date group inof.
#' @param group a character vector of columns for aggregation
#' @param is.output TRUE output decomp tables.
#' @param is.graph TRUE graph AVP chart.
#'
#' @return a list of modeling result. It contains the following components:
#'    con: contribution table
#'    decomp: decomp table 
#'    R2
#'    MAPE
#'    app: a shiny app
#'
#' @export
post_calc_sh=function(data,shrink,date.start,date.end,var.group,date.group,group,is.output=F,is.graph=T){
  require(shiny);require(rCharts);require(DT)
  ##########################################################
  # shrink=coef.sh#result from baysian_sh
  # var.group=var.group # variable group table
  # date.group=date.group # date group table
  # date.start="2010-01-26" 
  # date.end="2014-12-26"
  # group=c("group2") # dimension column names for aggregation
  # is.output=F # whether output decomp and contribution files
  # is.graph = T # whether show AVP
  ###########################################################
  group.input=group
  group=shrink$fit$group
  date.var=shrink$fit$date.var
  coef=as.data.table(shrink$coef,keep.rownames = T)
  # coef=as.data.table(fit.loop$coef,keep.rownames = T)
  coef.names=coef$rn
  index=data[[date.var]]>=date.start & data[[date.var]]<=date.end
  data=data.table(int=rep(1,nrow(data)),data)
  X=data[index,c(coef.names,date.var,group,shrink$fit$dep,shrink$fit$actual,shrink$fit$w),with=F]
  tempexpr=paste(group,":=as.character(",group,")",sep="")
  X[,eval(parse(text=tempexpr))]
  coef.final=melt.data.table(coef,id.vars="rn",variable.name=group)
  result=foreach(i=1:nrow(coef),.multicombine = T) %do% {
    temp=merge(X[,c(coef$rn[i],group,date.var,shrink$fit$w),with=F],coef.final[rn==coef$rn[i],!"rn",with=F],by=group,all.x=T)
    temp$y=temp[[coef$rn[i]]]*temp$value*temp[[shrink$fit$w]]
    temp=temp[,!c(coef$rn[i],"value",shrink$fit$w),with=F]
    setnames(temp,"y",coef$rn[i])
    temp
  }
  result.all=Reduce(function(...) merge(...,all=TRUE,by=c(group,date.var)), result)
  result.all=merge(result.all,X[,c(group,date.var,shrink$fit$dep,shrink$fit$actual,shrink$fit$w),with=F],by=c(group,date.var),all.x=T)
  result.all$yhat=apply(result.all[,coef.names,with=F],1,sum)
  result.all$yhati=result.all$yhat/result.all[[shrink$fit$w]]
  result.all$res=result.all[[fit$actual]]-result.all$yhat

  decomp.date=result.all[,lapply(.SD,sum),by=c(fit$date.var),.SDcols=c(coef.names,"yhat","res",shrink$fit$actual)]
  R2=1-sum((result.all[[fit$dep]]-result.all$yhati)^2)/sum((result.all[[fit$dep]]-mean(result.all[[fit$dep]]))^2)
  mape=mean(abs(result.all$res/result.all[[fit$actual]]))
  
  output=f_decomp_output(decomp=result.all,fit,date.start,date.end,var.group,date.group,group=group.input,is.output,is.graph)
  return(list(R2=R2,mape=mape,decomp=output$decomp,con=output$con,app=output$app))
}
xinzhou1023/shrinkest documentation built on May 4, 2019, 1:07 p.m.