#' 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))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.