#' Bayesian Shrikage function
#'
#' A function of Bayesian shrinkage Estimator.
#'
#' @param lm.loop a list of lm_loop output.
#' @param lm.pool a list of lm_pool output.
#' @param data.sign a data.table class dataset contains coefficient sign check info.
#' @param is.signcheck TRUE turns on coefficient sign check.
#' @param coef.lower a numeric value of the lower bound of the coefficients after shrinkage to the gloable ones. If value is 0.5, then the lower bound is 50% of gloable. Default is 0.5.
#' @param coef.upper a numeric value of the uppper bound of the coefficients after shrinkage to the gloable ones. If value is 1.5, then the upper bound is 150% of gloable. Default is 1.5.
#'
#' @return a list of modeling result. It contains the following components:
#' R2: a numeric of R2 from linear model.
#' mape: a numeric of MAPE from linear model.
#'
#' @export
baysian_sh=function(lm.loop,lm.pool,data.sign,coef.lower=0.5,coef.upper=1.5,is.signcheck=T){
require(data.table)
##################################################################################################
# # bayesian shrinkage and sign check; output coef.post (coef by cross section)
# lm.loop=fit.loop#result from lm_loop
# lm.pool=fit#result from lm_pool
# is.signcheck=F#whether do sign check
# data.sign=data.sign#sign check dataset
##################################################################################################
pool=as.data.table(lm.pool$coef,keep.rownames=T)[,c("rn","pool"),with=F]
data.sign=copy(data.sign)
setnames(data.sign,"var","rn")
setnames(pool,"pool","overall")
pool=merge(pool,data.sign,by="rn",all.x=T)
coef.post=foreach(i=1:ncol(lm.loop$coef),.multicombine = T) %do% {
temp=as.data.table(lm.loop$fit[[i]]$coef,keep.rownames = T)
temp=merge(temp,pool,by="rn",all.y = T)
temp=temp[,final:=overall*(1/(t.score)**2)+pool*(1-1/(t.score)**2)]
temp$t.score[is.na(temp$t.score)]=0
temp$final[(temp$t.score)**2<1]=temp$overall[(temp$t.score)**2<1]
temp$final[temp$is.var==0]=temp$overall[temp$is.var==0]
temp$final[is.na(temp$final)]=0
temp=temp[,':='(lower=overall-coef.lower*abs(overall),upper=overall+coef.upper*abs(overall))]
temp=temp[,final1:=final]
temp=temp[final<lower,final1:=lower]
temp=temp[final>upper,final1:=upper]
# sign check
if (is.signcheck){
temp[is.pos==1,final1:=ifelse((final1>=0),final1,0)]
temp[is.pos==0,final1:=ifelse((final1>=0),0,final1)]
}
temp=temp[,c("rn","final1"),with=F]
setnames(temp,"final1",paste("X",lm.loop$group[[i]],sep="_"))
}
coef=Reduce(function(...) merge(...,all.x=TRUE,by="rn"), coef.post)
A=coef[,c(2:ncol(coef)),with=F]
dimension=substring(colnames(A),3)
A=as.matrix(A)
B=matrix(A,nc=ncol(A),dimnames=list(coef$rn,dimension))
return(list(coef=B,fit=lm.pool))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.