Bayesian Models

Abstract

Bayesian models have become a mainstay in the tool set for marketing research in academia and industry practice. In this chapter, I discuss the advantages the Bayesian approach offers to researchers in marketing, the essential building blocks of a Bayesian model, Bayesian model comparison, and useful algorithmic approaches to fully Bayesian estimation. I show how to achieve feasible Bayesian inference to support marketing decisions under uncertainty using the Gibbs sampler, the Metropolis Hastings algorithm, and point to more recent developments – specifically the no-U-turn implementation of Hamiltonian Monte Carlo sampling available in Stan. The emphasis is on the development of an appreciation of Bayesian inference techniques supported by references to implementations in the open source software R, and not on the discussion of individual models. The goal is to encourage researchers to formulate new, more complete, and useful prior structures that can be updated with data for better marketing decision support.

Appendix

MCMC for Binomial Probit Without Data Augmentation

Simulate data, call MCMC routine, plot MCMC-traces. This R-script sources a RW-MH-sampler for the binomial probit model (see teh following script), simulates probit data, and runs the code with different step-sizes (standard deviations of ϵ).

# may need to install these packages first library ( bayesm ) library ( latex2exp ) # needs to be in R's working directory source (' rbprobitRWMetropolis .r') # function to simulate from binary probit simbprobit = function (X, beta ) { y= ifelse ((X%*% beta + rnorm ( nrow (X))) <0 ,0 ,1) list (X=X,y=y, beta = beta ) } nobs =500 # number of simulated observations X= cbind ( rep (1, nobs ), runif ( nobs ), runif ( nobs )) beta =c( -3 ,2 ,4) # data generating parameters nvar = ncol (X) simout = simbprobit (X, beta ) # probit responses y= simout $y R =200000 # length of MCMC sample # data list to passed to MCMC routine Data = list (X= simout $X,y= simout $y) Mcmc = list (R=R, keep =1) # prior mean set to zero, prior variances set to 100 Prior = list ( betabar = double ( nvar ),A= diag ( rep (.01, nvar ))) out _1= rbprobitRWMetropolis ( Data =Data, Mcmc =Mcmc, Prior =Prior, stepsize =.001) out _2= rbprobitRWMetropolis ( Data =Data, Mcmc =Mcmc, Prior =Prior, stepsize =.005) out _3= rbprobitRWMetropolis ( Data =Data, Mcmc =Mcmc, Prior =Prior, stepsize =.8) out _4= rbprobitRWMetropolis ( Data =Data, Mcmc =Mcmc, Prior =Prior, stepsize =3) windows () par ( mfrow =c (2,2)) matplot ( out _1$ betadraw, type ='l',xlab = “, ylab = “, main = TeX ('$\cr epsilon $-standard⌴deviation⌴=⌴.001 ')); grid () matplot ( out _2$ betadraw, type ='l',xlab = “, ylab = “, main = TeX ('$\cr epsilon $-standard⌴deviation⌴=⌴.005 ')); grid () matplot ( out _3$ betadraw, type ='l',xlab = “, ylab = “, main = TeX ('$\cr epsilon $-standard⌴deviation⌴=⌴.8 ')); grid () matplot ( out _4$ betadraw, type ='l',xlab = “, ylab = “, main = TeX ('$\cr epsilon $-standard⌴deviation⌴=⌴3')); grid ()

MCMC function. The following function implements a simple RW-MH-sampler for the binomial probit model coupled with a multivariate normal prior. All regression parameters are updated simultaneously in one MH-step.

rbprobitRWMetropolis <- function (Data, Prior, Mcmc, stepsize ) { require ( bayesm ) # because of the use of lndMnv to evaluate the log - density of a ... # ... multivariate normal distribution y = Data $y nvar = ncol (X) nobs = length (y) betabar = Prior $ betabar A = Prior $A R = Mcmc $R keep = Mcmc $ keep betadraw = matrix ( double ( floor (R/ keep ) * nvar ), ncol = nvar ) loglike = double ( floor (R/ keep )) beta = c( rep (0, nvar )) priorcov = chol2inv ( chol (A)) rootp = chol ( priorcov ) rootpi = backsolve (rootp, diag ( nvar )) # intialize log - likelihood at starting value oldloglike = sum ( pnorm (0, (X%*% beta )[ as. logical (y)], 1, log .p= TRUE ))+ sum ( pnorm (0, (-X%*% beta )[!as. logical (y)], 1, log .p= TRUE )) # compute non - normalized log - posterior at starting value oldlpost = oldloglike + lndMvn (beta, betabar, rootpi) naccept = 0 for ( rep in 1:R) { betac = beta + rnorm ( nvar )* stepsize # random walk proposal # compute probit log - likelihood at proposed value cloglike = sum ( pnorm (0, -(X%*% betac )[ as. logical (y)], 1, log .p= TRUE ))+ sum ( pnorm (0, (X%*% betac )[!as. logical (y)], 1, log .p= TRUE )) # compute non - normalized log - posterior at proposed value clpost = cloglike + lndMvn (betac, betabar, rootpi ) # compute log - ratio of non - normalized posterior at proposed ... # ... and old value ldiff = clpost - oldlpost alpha = min (1, exp ( ldiff )) # acceptance probability if ( alpha < 1) { unif = runif (1) } else { unif = 0 } if ( unif <= alpha ) { beta = betac oldloglike = cloglike oldlpost = clpost naccept = naccept + 1 } if ( rep %% keep == 0) { mkeep = rep / keep betadraw [mkeep, ] = beta loglike [ mkeep ] = oldloglike } } # betadraw is the matrix containing draws from the posterior # rateaccept is the relative frequency of accpeting proposed moves ... # ... from oldbeta to betac # loglike is the log - likelihood ... # ... evaluated at the current MCMC state ( beta ) return ( list ( betadraw = betadraw, mkeep =mkeep, rateaccept = naccept /R, loglike = loglike )) }

Stan probit definition file. This file that is called as StanProbit.stan by the R-script immediately below defines a binomial probit model with a multivariate normal prior for Stan. According to the model, the data are independently Bernoulli distributed with probabilities implied by the probit-link, parameters, and covariates.

data { int N; // number of observations int K; // number of covariates int < lower =0, upper =1> y[N]; // information matrix [N,K] X; // design matrix } parameters { vector [K] beta ; // beta coefficients } model { vector [N] mu; beta ^~ normal (0, 100); mu = X* beta ; for (n in 1:N) mu[n] = Phi (mu[n ]); y ^~ bernoulli (mu ); }

Calling Stan from R to estimate a binomial probit model. This R-script calls Stan to sample from the posterior of the binomial probit model coupled with a multivariate normal prior defined in the file above.

# may need to install the rstan package first require ( rstan ) # load the rstan package # see sripts above for nobs, nvar, simout objects prob _ data = list (N=nobs ,K=nvar ,X= simout $X,y=as. vector ( simout $y)) rstan _ options ( auto _ write = TRUE ) options (mc. cores = parallel :: detectCores ()) stanfit _ probit = stan ( file =" StanProbit . stan ",data = prob _ data, pars = c(" beta "), chains = 1, iter = 600000, warmup = 1000) # Make draws available for posterior analysis in R out _ StanProbit = extract ( stanfit _ probit )

HB -Logit Example

This code generates MNL-data from a hierarchical model, estimates an HB-logit model, and compares selected individual level posteriors to the corresponding maximum likelihood estimates.

genXy <- function (betai ,p,T){ ## generate multinomial logit choices # alternative specific constants # ... this assumes p=3 ( two inside brands, one outside choice ) X= kronecker ( rep (1,T), matrix (c(1 ,0 ,0 ,0 ,1 ,0) , ncol =( length ( betai ) -1))) # add the continuous covariate X= cbind (X, runif (T*p)) index = seq (p,p*T,p) X[index ,]=0 # outside good Xbeta =t( matrix (X%*%betai , nrow =p)) index = cbind (1:T, max . col ( Xbeta )) maxl = Xbeta [ index ] logsumel = log ( rowSums ( exp (Xbeta - maxl ))) + maxl logprob = matrix (Xbeta - logsumel , nrow =T) y= double (T) for (t in 1:T){ y[t]= sum ( cumsum ( exp ( logprob [t ,])) < runif (1))+1 ## draw from the CDF of probs } return ( list (y=y,X=X)) } p=3 # number of alterantives in each choice set T=5 # number of repeated measurements, i.e., choice sets or choices # generate panel data for MCMC analysis N =2000 # number of individuals in the panel # population mean preference betap =c(.3 , -2 , -1) # variance - covariance of preferences in the population Vbeta = matrix (c(3 , -2.99 ,0 , -2.99 ,3 ,0 ,0 ,0 ,.1) , ncol =3) # just for demonstration to make sure we all get ... # ... the same result date and results set . seed (66) # draw individual specific preferences from MVNormal distribution betai = betap +t( chol ( Vbeta ))%*% matrix ( rnorm (N* length ( betap )), ncol =N) lgtdata <- vector (" list ", N) T=5 # number of choices per individual betaMLE = betai betaMLE [ , ]=0 for (i in 1:N){ outgen = genXy ( betai [,i],p,T) # For Bayesian analysis using rhierMnlRwMixture ... # ... you need to organize your data in list format as ... # ... in the command line below # y :: vector of choice outcomes of length T or ... # ... T_i in case different panel units provide different numbers of choices # X :: A (p*T) rows x length ( beta [,i]) columns model matrix ; # the first ( second ) p rows correspond to the first ( second ) choice set, and so on. # Each alternative is represented by one row in X. # The numbers in y point to which 'row ' was chosen from a particular choice set lgtdata [[i ]]= list (y= outgen [[1]], X= outgen [[2]]) out = optim ( par = betai [,i], fn=llMNL, gr=NULL, y= outgen [[1]], X= outgen [[2]], p=p, hessian = FALSE, control = list ( fnscale = -1)) betaMLE [,i]= out $ par # collect MLE estimates } # load the bayesm package into the workspace # (if this gives you an error, ... # ... you need to install the package first ) library ( bayesm ) # run the Bayesian hierarchical model outMCMC = rhierMnlRwMixture ( Data = list (p=p, lgtdata = lgtdata ), Prior = list ( ncomp =1), Mcmc = list (R =100000, keep =10)) # posterior of individual specific coefficients betaimc = outMCMC $ betadraw index =1001:10000 # may need to install this first library ( latex2exp ) M=c (3 ,99 ,2000) # plot betai posterior for consumers in M jpeg ( filename =" ILposteriors880 . jpg ", quality = 100 , width = 880 , height = 480) # windows () par ( mfcol =c( length ( betap ), length (M)* 2)) for (i in M){ plot ( density ( betaimc [i ,1, index ]), xlab = TeX ('$\cr beta _{A}$'), ylab = "⌴", main = paste ("panel - unit⌴", i)) abline (v= betai [1,i], col ='green ', lwd =5, lty =1 ) abline (v= betaMLE [1,i], col ='red ', lwd =5, lty =2 ) plot ( density ( betaimc [i ,2, index ]), xlab = TeX ('$\cr beta _{B}$'), ylab = "⌴", main ="⌴") abline (v= betai [2,i], col ='green ', lwd =5, lty =1 ) abline (v= betaMLE [2,i], col ='red ', lwd =5, lty =2 ) plot ( density ( betaimc [i ,3, index ]), xlab = TeX ('$\cr beta $'), ylab = "⌴", main ="⌴") abline (v= betai [3,i], col ='green ', lwd =5, lty =1 ) abline (v= betaMLE [3,i], col ='red ', lwd =5, lty =2 ) plot ( betaimc [i ,1, index ], type ='l', xlab ="⌴", ylab = TeX ('$\cr beta _{A}$'), main = paste (" MLE : ⌴", round ( betaMLE [1,i ]))) abline (h= betai [1,i], col ='green ', lwd =5, lty =1 ) abline (h= betaMLE [1,i], col ='red ', lwd =5, lty =2 ) plot ( betaimc [i ,2, index ], type ='l', xlab ="⌴", ylab = TeX ('$\cr beta _{B}$'), main = paste (" MLE : ⌴", round ( betaMLE [2,i ]))) abline (h= betai [2,i], col ='green ', lwd =5, lty =1 ) abline (h= betaMLE [2,i], col ='red ', lwd =5, lty =2 ) plot ( betaimc [i ,3, index ], type ='l', xlab ="⌴", ylab = TeX ('$\cr beta $'), main = paste (" MLE : ⌴", round ( betaMLE [3,i ]))) abline (h= betai [3,i], col ='green ', lwd =5, lty =1 ) abline (h= betaMLE [3,i], col ='red ', lwd =5, lty =2 ) }