\documentclass[nojss]{jss}
%% need no \usepackage{Sweave.sty}
\usepackage{amsmath}

%\VignetteIndexEntry{LaplacesDemon Examples}
%\VignettePackage{LaplacesDemon}
%\VignetteDepends{LaplacesDemon}

\author{Statisticat, LLC}
\title{\includegraphics[height=1in,keepaspectratio]{LDlogo} \\ \pkg{LaplacesDemon} Examples}

%% for pretty printing and a nice hypersummary also set:
\Plainauthor{Statisticat LLC} %% comma-separated
\Plaintitle{LaplacesDemon Examples} %% without formatting
\Shorttitle{Examples} %% a short title (if necessary)

\Abstract{The \pkg{LaplacesDemon} package is a complete environment for Bayesian inference within \proglang{R}. Virtually any probability model may be specified. This vignette is a compendium of examples of how to specify different model forms.
}
\Keywords{Bayesian, LaplacesDemon, LaplacesDemonCpp, R}
\Plainkeywords{bayesian, laplacesdemon, laplacesdemoncpp, r}

%% publication information
%% NOTE: Typically, this can be left commented and will be filled out by the technical editor
%% \Volume{13}
%% \Issue{9}
%% \Month{September}
%% \Year{2011}
%% \Submitdate{2011-01-18}
%% \Acceptdate{2011-01-18}

\Address{
  Statisticat, LLC\\
  Farmington, CT\\
  E-mail: defunct\\
  URL: \url{https://web.archive.org/web/20141224051720/http://www.bayesian-inference.com/index}
}

%% for those who use Sweave please include the following line (with % symbols):
%% need no \usepackage{Sweave.sty}

\begin{document}
\pkg{LaplacesDemon} \citep{r:laplacesdemon}, often referred to as LD, is an \proglang{R} package that is available at \url{https://web.archive.org/web/20150430054143/http://www.bayesian-inference.com/software}. \pkg{LaplacesDemonCpp} is an extension package that uses \proglang{C++}. A formal introduction to \pkg{LaplacesDemon} is provided in an accompanying vignette entitled ``\pkg{LaplacesDemon} Tutorial'', and an introduction to Bayesian inference is provided in the ``Bayesian Inference'' vignette.

The purpose of this document is to provide users of the \pkg{LaplacesDemon} package with examples of a variety of Bayesian methods. It is also a testament to the diverse applicability of \pkg{LaplacesDemon} to Bayesian inference.

To conserve space, the examples are not worked out in detail, and only the minimum of necessary materials is provided for using the various methodologies. Necessary materials include the form expressed in notation, data (which is often simulated), the \code{Model} function, and initial values. The provided data, model specification, and initial values may be copy/pasted into an \proglang{R} file and updated with the \code{LaplacesDemon} or (usually) \code{LaplaceApproximation} functions. Although many of these examples update quickly, some examples are computationally intensive.

All examples are provided in R code, but the model specification function can be in another language. A goal is to provide these example model functions in C++ as well, and some are now available at \url{https://web.archive.org/web/20140513065103/http://www.bayesian-inference.com/cpp/LaplacesDemonExamples.txt}.

Initial values are usually hard-coded in the examples, though the Parameter-Generating Function (PGF) is also specified. It is recommended to generate initial values with the \code{GIV} function according to the user-specified \code{PGF}.

Notation in this vignette follows these standards: Greek letters represent parameters, lower case letters represent indices, lower case bold face letters represent scalars or vectors, probability distributions are represented with calligraphic font, upper case letters represent index limits, and upper case bold face letters represent matrices. More information on notation is available at \url{https://web.archive.org/web/20150501205317/http://www.bayesian-inference.com/notation}.

This vignette may grow over time as examples of more methods become included. Contributed examples are welcome via \url{https://github.com/LaplacesDemonR/LaplacesDemon/issues}. All accepted contributions are, of course, credited.

\begin{center} \Large{\textbf{Contents}} \end{center}
\begin{itemize}
\item Adaptive Logistic Basis (ALB) Regression \ref{alb}
\item ANCOVA \ref{ancova}
\item ANOVA, One-Way \ref{anova.one.way}
\item ANOVA, Two-Way \ref{anova.two.way}
\item Approximate Bayesian Computation (ABC) \ref{abc}
\item AR(p) \ref{arp}
\item AR(p)-ARCH(q) \ref{arparchq}
\item AR(p)-ARCH(q)-M \ref{arparchqm}
\item AR(p)-GARCH(1,1) \ref{arpgarch}
\item AR(p)-GARCH(1,1)-M \ref{arpgarchm}
\item AR(p)-TARCH(q) \ref{arptarchq}
\item AR(p)-TARCH(q)-M \ref{arptarchqm}
\item Autoregressive Moving Average, ARMA(p,q) \ref{armapq}
\item Beta Regression \ref{beta.reg}
\item Beta-Binomial \ref{beta.binomial}
\item Binary Logit \ref{binary.logit}
\item Binary Log-Log Link Mixture \ref{binary.loglog.mixture}
\item Binary Probit \ref{binary.probit}
\item Binary Robit \ref{binary.robit}
\item Binomial Logit \ref{binomial.logit}
\item Binomial Probit \ref{binomial.probit}
\item Binomial Robit \ref{binomial.robit}
\item Change Point Regression \ref{changepoint}
\item Cluster Analysis, Confirmatory (CCA) \ref{cca}
\item Cluster Analysis, Exploratoryy (ECA) \ref{eca}
\item Collaborative Filtering (CF) \ref{eofa}
\item Conditional Autoregression (CAR), Poisson \ref{car.poisson}
\item Conditional Predictive Ordinate (CPO) \ref{cpo}
\item Contingency Table \ref{contingency.table}
\item Dirichlet Process \ref{eca} \ref{imm}
\item Discrete Choice, Conditional Logit \ref{conditional.logit}
\item Discrete Choice, Mixed Logit \ref{dc.mixed.logit}
\item Discrete Choice, Multinomial Probit \ref{dc.mnp}
\item Distributed Lag, Koyck \ref{dl.koyck}
\item Dynamic Linear Model (DLM) \ref{dfa} \ref{ssm.lin.reg} \ref{ssm.ll} \ref{ssm.llt}
\item Dynamic Sparse Factor Model (DSFM) \ref{dsfm}
\item Exponential Smoothing \ref{exp.smo}
\item Factor Analysis, Approximate Dynamic (ADFA) \ref{adfa}
\item Factor Analysis, Confirmatory (CFA) \ref{cfa}
\item Factor Analysis, Dynamic (DFA) \ref{dsfm}
\item Factor Analysis, Exploratory (EFA) \ref{efa}
\item Factor Analysis, Exploratory Ordinal (EOFA) \ref{eofa}
\item Factor Regression \ref{factor.reg}
\item Gamma Regression \ref{gamma.reg}
\item Gaussian Process Regression \ref{kriging}
\item Geographically Weighted Regression \ref{gwr}
\item Hidden Markov Model \ref{hmm}
\item Hierarchical Bayes \ref{linear.reg.hb}
\item Horseshoe Regression \ref{horseshoe}
\item Inverse Gaussian Regression \ref{ig.reg}
\item Kriging \ref{kriging}
\item Kriging, Predictive Process \ref{kriging.pp}
\item Laplace Regression \ref{laplace.reg}
\item LASSO \ref{bal} \ref{lasso}
\item Latent Dirichlet Allocation (LDA) \ref{lda}
\item Linear Regression \ref{linear.reg}
\item Linear Regression, Frequentist \ref{linear.reg.freq}
\item Linear Regression, Hierarchical Bayesian \ref{linear.reg.hb}
\item Linear Regression, Multilevel \ref{linear.reg.ml}
\item Linear Regression with Full Missingness \ref{linear.reg.full.miss}
\item Linear Regression with Missing Response \ref{linear.reg.miss.resp}
\item Linear Regression with Missing Response via ABB \ref{linear.reg.miss.resp.abb}
\item Linear Regression with Power Priors \ref{linear.reg.pp}
\item Linear Regression with Zellner's g-Prior \ref{linear.reg.g}
\item LSTAR \ref{lstar}
\item MANCOVA \ref{mancova}
\item MANOVA \ref{manova}
\item Missing Values \ref{linear.reg.full.miss} \ref{linear.reg.miss.resp} \ref{linear.reg.miss.resp.abb}
\item Mixed Logit \ref{mixed.logit}
\item Mixture Model, Finite \ref{cca} \ref{fmm}
\item Mixture Model, Infinite \ref{eca} \ref{imm}
\item Mixture Model, Poisson-Gamma \ref{poisson.gamma}
\item Model Averaging \ref{ssvs} \ref{rj}
\item Multilevel Model \ref{linear.reg.ml}
\item Multinomial Logit \ref{mnl}
\item Multinomial Logit, Nested \ref{nmnl}
\item Multinomial Probit \ref{mnp}
\item Multiple Discrete-Continuous Choice \ref{mdcc}
\item Multivariate Binary Probit \ref{multiv.bin.probit}
\item Multivariate Laplace Regression \ref{multivariate.lap.reg}
\item Multivariate Poisson Regression \ref{multivariate.pois.reg}
\item Multivariate Regression \ref{multivariate.reg}
\item Negative Binomial Regression \ref{negbin.reg}
\item Normal, Multilevel \ref{norm.ml}
\item Ordinal Logit \ref{ordinal.logit}
\item Ordinal Probit \ref{ordinal.probit}
\item Panel, Autoregressive Poisson \ref{panel.ap}
\item Penalized Spline Regression \ref{pspline}
\item Poisson Regression \ref{poisson.reg}
\item Poisson Regression, Overdispersed \ref{poisson.gamma} \ref{negbin.reg}
\item Poisson-Gamma Regression \ref{poisson.gamma}
\item Polynomial Regression \ref{polynomial.reg}
\item Power Priors \ref{linear.reg.pp}
\item Proportional Hazards Regression, Weibull \ref{prop.haz.weib}
\item PVAR(p) \ref{pvarp}
\item Quantile Regression \ref{quantile.reg}
\item Revision, Normal \ref{revision.normal}
\item Ridge Regression \ref{ridge.reg}
\item Robust Regression \ref{robust.reg}
\item Seemingly Unrelated Regression (SUR) \ref{sur}
\item Simultaneous Equations \ref{simultaneous}
\item Space-Time, Dynamic \ref{spacetime.dynamic}
\item Space-Time, Nonseparable \ref{spacetime.nonsep}
\item Space-Time, Separable \ref{spacetime.sep}
\item Spatial Autoregression (SAR) \ref{sar}
\item STARMA(p,q) \ref{starma}
\item State Space Model (SSM), Dynamic Sparse Factor Model (DSFM) \ref{dsfm}
\item State Space Model (SSM), Linear Regression \ref{ssm.lin.reg}
\item State Space Model (SSM), Local Level \ref{ssm.ll}
\item State Space Model (SSM), Local Linear Trend \ref{ssm.llt}
\item State Space Model (SSM), Stochastic Volatility (SV) \ref{sv}
\item Stochastic Volatility (SV) \ref{sv}
\item Survival Model \ref{prop.haz.weib}
\item T-test \ref{anova.one.way}
\item Threshold Autoregression (TAR) \ref{tar}
\item Topic Model \ref{lda}
\item Time Varying AR(1) with Chebyshev Series \ref{tvarcs}
\item Variable Selection, BAL \ref{bal}
\item Variable Selection, Horseshoe \ref{horseshoe}
\item Variable Selection, LASSO \ref{lasso}
\item Variable Selection, RJ \ref{rj}
\item Variable Selection, SSVS \ref{ssvs}
\item VARMA(p,q) - SSVS \ref{varmapqssvs}
\item VAR(p)-GARCH(1,1)-M \ref{varpgarchm}
\item VAR(p) with Minnesota Prior \ref{varp}
\item VAR(p) with SSVS \ref{varpssvs}
\item Variety Model \ref{mdcc}
\item Weighted Regression \ref{weighted.reg}
\item Zellner's g-Prior \ref{linear.reg.g}
\item Zero-Inflated Poisson (ZIP) \ref{zip}
\end{itemize}

\section{Adaptive Logistic Basis (ALB) Regression} \label{alb}
Adaptive Logistic Basis (ALB) regression is an essentially automatic non-parametric approach to estimating the nonlinear relationship between each of multiple independent variables (IVs) and the dependent variable (DV). It is automatic because when using the suggested $K = 2J + 1$ components (see below) given $J$ IVs, the data determines the nonlinear relationships, whereas in other methods, such as with splines, the user must specify the number of knots and possibly consider placement of the knots. Knots do not exist in ALB. Both the DV and IVs should be centered and scaled.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu = \textbf{S}\delta$$
$$\textbf{S}_{i,m} = \frac{\phi_{i,m}}{\sum^M_{m=1} \phi_{i,m}}$$
$$\phi_{i,m} = \exp(\alpha_m + \textbf{X}_{i,1:J}\beta_{1:J,m}), \quad i=1,\dots,N, \quad m=1,\dots,M$$
$$\alpha_m \sim \mathcal{N}(0, 10), \quad m=1,\dots,(M-1)$$
$$\alpha_M = 0$$
$$\beta_{j,m} \sim \mathcal{N}(0, 100), \quad j=1,\dots,J, \quad m=1,\dots,(M-1)$$
$$\beta_{j,M} = 0$$
$$\delta_m \sim \mathcal{N}(\zeta, \tau^2), \quad m=1,\dots,M$$
$$\sigma \sim \mathcal{HC}(25)$$
$$\zeta \sim \mathcal{N}(0, 10)$$
$$\tau \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonsnacks) \\
N <- nrow(demonsnacks) \\
y <- log(demonsnacks$Calories) \\
X <- as.matrix(log(demonsnacks[,c(1,4,10)]+1)) \\
J <- ncol(X) \\
y <- CenterScale(y) \\
for (j in 1:J) X[,j] <- CenterScale(X[,j]) \\
K <- 2*J+1 \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=rep(0,K-1), beta=matrix(0,J,K-1), \\
\hspace*{0.27 in} delta=rep(0,K), zeta=0, sigma=0, tau=0)) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.delta <- grep("delta", parm.names) \\
pos.zeta <- grep("zeta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
pos.tau <- grep("tau", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(Data$K-1) \\
\hspace*{0.27 in} beta <- rnorm(Data$J*(Data$K-1)) \\
\hspace*{0.27 in} delta <- rnorm(Data$K) \\
\hspace*{0.27 in} zeta <- rnorm(1) \\
\hspace*{0.27 in} sigma <- rhalfcauchy(1,5) \\
\hspace*{0.27 in} tau <- rhalfcauchy(1,5) \\
\hspace*{0.27 in} return(c(alpha, beta, delta, zeta, sigma, tau)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, y=y, pos.alpha=pos.alpha, pos.beta=pos.beta, \\
\hspace*{0.27 in} pos.delta=pos.delta, pos.zeta=pos.zeta, pos.sigma=pos.sigma, \\
\hspace*{0.27 in} pos.tau=pos.tau) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Hyperparameters \\
\hspace*{0.27 in} zeta <- parm[Data$pos.zeta] \\
\hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J, Data$K-1) \\
\hspace*{0.27 in} delta <- parm[Data$pos.delta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Hyperprior \\
\hspace*{0.27 in} zeta.prior <- dnormv(zeta, 0, 10, log=TRUE) \\
\hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 10, log=TRUE)) \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 100, log=TRUE)) \\
\hspace*{0.27 in} delta.prior <- sum(dnorm(delta, zeta, tau, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} phi <- cbind(exp(matrix(alpha, Data$N, Data$K-1, byrow=TRUE) + \\
\hspace*{0.62 in} tcrossprod(Data$X, t(beta))),1) \\
\hspace*{0.27 in} mu <- tcrossprod(phi / rowSums(phi), t(delta)) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + delta.prior + zeta.prior \\
\hspace*{0.62 in} sigma.prior + tau.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,K), rep(0,J*(K-1)), rep(0,K-1), 0, 1, 1)}

\section{ANCOVA} \label{ancova}
This example is essentially the same as the two-way ANOVA (see section \ref{anova.two.way}), except that a covariate $\textbf{X}_{,3}$ has been added, and its parameter is $\delta$.
\subsection{Form}
$$\textbf{y}_i \sim \mathcal{N}(\mu_i, \sigma^2_1)$$
$$\mu_i = \alpha + \beta[\textbf{X}_{i,1}] + \gamma[\textbf{X}_{i,2}] + \delta \textbf{X}_{i,2}, \quad i=1,\dots,N$$
$$\epsilon_i = \textbf{y}_i - \mu_i$$
$$\alpha \sim \mathcal{N}(0, 1000)$$
$$\beta_j \sim \mathcal{N}(0, \sigma^2_2), \quad j=1,\dots,J$$
$$\beta_J = - \sum^{J-1}_{j=1} \beta_j$$
$$\gamma_k \sim \mathcal{N}(0, \sigma^2_3), \quad k=1,\dots,K$$
$$\gamma_K = - \sum^{K-1}_{k=1} \gamma_k$$
$$\delta \sim \mathcal{N}(0, 1000)$$
$$\sigma_m \sim \mathcal{HC}(25), \quad m=1,\dots,3$$
\subsection{Data}
\code{N <- 100 \\
J <- 5 \#Number of levels in factor (treatment) 1 \\
K <- 3 \#Number of levels in factor (treatment) 2 \\
X <- cbind(rcat(N,rep(1/J,J)), rcat(N,rep(1/K,K)), runif(N,-2,2)) \\
alpha <- runif(1,-1,1) \\
beta <- runif(J-1,-2,2) \\
beta <- c(beta, -sum(beta)) \\
gamma <- runif(K-1,-2,2) \\
gamma <- c(gamma, -sum(gamma)) \\
delta <- runif(1,-2,2) \\
y <- alpha + beta[X[,1]] + gamma[X[,2]] + delta*X[,3] + rnorm(N,0,0.1) \\
mon.names <- c("LP", paste("beta[",J,"]",sep=""), \\
\hspace*{0.27 in} paste("gamma[",K,"]",sep=""),"s.beta","s.gamma","s.epsilon") \\
parm.names <- as.parm.names(list(alpha=0, beta=rep(0,J-1), gamma=rep(0,K-1), \\
\hspace*{0.27 in} delta=0, sigma=rep(0,3))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
pos.delta <- grep("delta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(1) \\
\hspace*{0.27 in} beta <- rnorm(Data$J-1) \\
\hspace*{0.27 in} gamma <- rnorm(Data$K-1) \\
\hspace*{0.27 in} delta <- rnorm(1) \\
\hspace*{0.27 in} sigma <- runif(3) \\
\hspace*{0.27 in} return(c(alpha, beta, gamma, delta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, \\
\hspace*{0.27 in} pos.beta=pos.beta, pos.gamma=pos.gamma, pos.delta=pos.delta, \\
\hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} beta <- c(beta, -sum(beta)) \#Sum-to-zero constraint \\
\hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\
\hspace*{0.27 in} gamma <- c(gamma, -sum(gamma)) \#Sum-to-zero constraint \\
\hspace*{0.27 in} delta <- parm[Data$pos.delta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, sigma[2], log=TRUE)) \\
\hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, sigma[3], log=TRUE)) \\
\hspace*{0.27 in} delta.prior <- dnormv(delta, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- alpha + beta[Data$X[,1]] + gamma[Data$X[,2]] + \\
\hspace*{0.62 in} delta*Data$X[,3] \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Variance Components \\
\hspace*{0.27 in} s.beta <- sd(beta) \\
\hspace*{0.27 in} s.gamma <- sd(gamma) \\
\hspace*{0.27 in} s.epsilon <- sd(Data$y - mu) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + delta.prior + \\
\hspace*{0.62 in} sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, beta[Data$J], \\
\hspace*{0.62 in} gamma[Data$K], s.beta, s.gamma, s.epsilon), \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(0, rep(0,(J-1)), rep(0,(K-1)), 0, rep(1,3))}

\section{ANOVA, One-Way} \label{anova.one.way}
When $J=2$, this is a Bayesian form of a t-test.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2_1)$$
$$\mu_i = \alpha + \beta[\textbf{x}_i], \quad i=1,\dots,N$$
$$\alpha \sim \mathcal{N}(0, 1000)$$
$$\beta_j \sim \mathcal{N}(0, \sigma^2_2), \quad j=1,\dots,J$$
$$\beta_J = - \displaystyle\sum^{J-1}_{j=1} \beta_j$$
$$\sigma_{1:2} \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{N <- 1000 \\
J <- 3 \\
x <- rcat(N, rep(1/J, J)) \\
alpha <- runif(1,-1,1) \\
beta <- runif(J-1,-2,2) \\
beta <- c(beta, -sum(beta)) \\
y <- alpha + beta[x] + rnorm(N,0,0.2) \\
mon.names <- c("LP",paste("beta[",J,"]",sep="")) \\
parm.names <- as.parm.names(list(alpha=0, beta=rep(0,J-1), sigma=rep(0,2))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(1) \\
\hspace*{0.27 in} beta <- rnorm(Data$J-1) \\
\hspace*{0.27 in} sigma <- runif(2) \\
\hspace*{0.27 in} return(c(alpha, beta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, N=N, PGF=PGF, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\
\hspace*{0.27 in} pos.sigma=pos.sigma, x=x, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} beta <- c(beta, -sum(beta)) \#Sum-to-zero constraint \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, sigma[2], log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- alpha + beta[Data$x] \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,beta[Data$J]), \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(0, rep(0,(J-1)), rep(1,2))}

\section{ANOVA, Two-Way} \label{anova.two.way}
In this representation, $\sigma^m$ are the superpopulation variance components, \code{s.beta} and \code{s.gamma} are the finite-population within-variance components of the factors or treatments, and \code{s.epsilon} is the finite-population between-variance component.
\subsection{Form}
$$\textbf{y}_i \sim \mathcal{N}(\mu_i, \sigma^2_1)$$
$$\mu_i = \alpha + \beta[\textbf{X}_{i,1}] + \gamma[\textbf{X}_{i,2}], \quad i=1,\dots,N$$
$$\epsilon_i = \textbf{y}_i - \mu_i$$
$$\alpha \sim \mathcal{N}(0, 1000)$$
$$\beta_j \sim \mathcal{N}(0, \sigma^2_2), \quad j=1,\dots,J$$
$$\beta_J = - \sum^{J-1}_{j=1} \beta_j$$
$$\gamma_k \sim \mathcal{N}(0, \sigma^2_3), \quad k=1,\dots,K$$
$$\gamma_K = - \sum^{K-1}_{k=1} \gamma_k$$
$$\sigma_m \sim \mathcal{HC}(25), \quad m=1,\dots,3$$
\subsection{Data}
\code{N <- 1000 \\
J <- 5 \#Number of levels in factor (treatment) 1 \\
K <- 3 \#Number of levels in factor (treatment) 2 \\
X <- cbind(rcat(N,rep(1/J,J)), rcat(N,rep(1/K,K))) \\
alpha <- runif(1,-1,1) \\
beta <- runif(J-1,-2,2) \\
beta <- -sum(beta) \\
gamma <- runif(K-1,-2,2) \\
gamma <- -sum(gamma) \\
y <- alpha + beta[X[,1]] + gamma[X[,2]] + rnorm(N,0,0.1) \\
mon.names <- c("LP", paste("beta[",J,"]",sep=""), \\
\hspace*{0.27 in} paste("gamma[",K,"]",sep=""), "s.beta", "s.gamma", "s.epsilon") \\
parm.names <- as.parm.names(list(alpha=0, beta=rep(0,J-1), gamma=rep(0,K-1), \\
\hspace*{0.27 in} sigma=rep(0,3))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(1) \\
\hspace*{0.27 in} beta <- rnorm(Data$J-1) \\
\hspace*{0.27 in} gamma <- rnorm(Data$K-1) \\
\hspace*{0.27 in} sigma <- runif(3) \\
\hspace*{0.27 in} return(c(alpha, beta, gamma, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\
\hspace*{0.27 in} pos.gamma=pos.gamma, pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} beta <- c(beta, -sum(beta)) \#Sum-to-zero constraint \\
\hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\
\hspace*{0.27 in} gamma <- c(gamma, -sum(gamma)) \#Sum-to-zero constraint \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, sigma[2], log=TRUE)) \\
\hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, sigma[3], log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- alpha + beta[Data$X[,1]] + gamma[Data$X[,2]] \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Variance Components \\
\hspace*{0.27 in} s.beta <- sd(beta) \\
\hspace*{0.27 in} s.gamma <- sd(gamma) \\
\hspace*{0.27 in} s.epsilon <- sd(Data$y - mu) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, beta[Data$J], \\
\hspace*{0.62 in} gamma[Data$K], s.beta, s.gamma, s.epsilon), \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(0, rep(0,(J-1)), rep(0,(K-1)), rep(1,3))}

\section{Approximate Bayesian Computation (ABC)} \label{abc}
Approximate Bayesian Computation (ABC), also called likelihood-free estimation, is not a statistical method, but a family of numerical approximation techniques in Bayesian inference. ABC is especially useful when evaluation of the likelihood, $p(\textbf{y} | \Theta)$ is computationally prohibitive, or when suitable likelihoods are unavailable. The current example is the application of ABC in the context of linear regression. The log-likelihood is replaced with the negative sum of the distance between $\textbf{y}$ and $\textbf{y}^{rep}$ as the approximation of the log-likelihood. Distance reduces to the absolute difference. Although linear regression has an easily calculated likelihood, it is used as an example due to its generality. This example demonstrates how ABC may be estimated either with MCMC via the \code{LaplacesDemon} function or with Laplace Approximation via the \code{LaplaceApproximation} function. In this method, a tolerance (which is found often in ABC) does not need to be specified, and the logarithm of the unnormalized joint posterior density is maximized, as usual. The negative and summed distance, above, may be replaced with the negative and summed distance between summaries of the data, rather than the data itself, but this has not been desirable in testing.
\subsection{Form}
$$\textbf{y} = \mu + \epsilon$$
$$\mu = \textbf{X} \beta$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
\subsection{Data}
\code{data(demonsnacks) \\
y <- log(demonsnacks$Calories) \\
X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\
J <- ncol(X) \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
mon.names <- c("LP","sigma") \\
parm.names <- as.parm.names(list(beta=rep(0,J))) \\
pos.beta <- grep("beta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} return(beta) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood Approximation \\
\hspace*{0.27 in} mu <- as.vector(tcrossprod(Data$X, t(beta))) \\
\hspace*{0.27 in} epsilon <- Data$y - mu \\
\hspace*{0.27 in} sigma <- sd(epsilon) \\
\hspace*{0.27 in} LL <- -sum(abs(epsilon)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior Approximation \\
\hspace*{0.27 in} LP <- LL + beta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,sigma), \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J))}

\section{AR(p)} \label{arp}
\subsection{Form}
$$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2), \quad t=1,\dots,T$$
$$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p}, \quad t=1,\dots,T$$
$$\alpha \sim \mathcal{N}(0, 1000)$$
$$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonfx) \\
y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\
T <- length(y) \\
L <- c(1,5,20) \#Autoregressive lags \\
P <- length(L) \#Autoregressive order \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), sigma=0)) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(1) \\
\hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\
\hspace*{0.27 in} sigma <- rhalfcauchy(1,5) \\
\hspace*{0.27 in} return(c(alpha, phi, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(L=L, PGF=PGF, P=P, T=T, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\
\hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} phi <- parm[Data$pos.phi] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- rep(alpha, Data$T) \\
\hspace*{0.27 in} for (p in 1:Data$P) \\
\hspace*{0.62 in} mu[-c(1:Data$L[p])] <- mu[-c(1:Data$L[p])] + \\
\hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L[p])] \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y[-c(1:Data$L[Data$P])], mu[-c(1:Data$L[Data$P])], \\
\hspace*{0.62 in} sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,P+1), 1)}

\section{AR(p)-ARCH(q)} \label{arparchq}
\subsection{Form}
$$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=1,\dots,T$$
$$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p}, \quad t=1,\dots,T$$
$$\epsilon_t = \textbf{y}_t - \mu_t$$
$$\alpha \sim \mathcal{N}(0, 1000)$$
$$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$
$$\sigma^2_t = \omega + \sum^Q_{q=1} \theta_q \epsilon^2_{t-q}, \quad t=2,\dots,T$$
$$\omega \sim \mathcal{HC}(25)$$
$$\theta_q \sim \mathcal{U}(0, 1), \quad q=1,\dots,Q$$
\subsection{Data}
\code{data(demonfx) \\
y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\
T <- length(y) \\
L.P <- c(1,5,20) \#Autoregressive lags \\
L.Q <- c(1,2) \#Volatility lags \\
P <- length(L.P) \#Autoregressive order \\
Q <- length(L.Q) \#Volatility order \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), omega=0, \\
\hspace*{0.27 in} theta=rep(0,Q))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.omega <- grep("omega", parm.names) \\
pos.theta <- grep("theta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(1) \\
\hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\
\hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\
\hspace*{0.27 in} theta <- runif(Data$Q, 1e-10, 1-1e-5) \\
\hspace*{0.27 in} return(c(alpha, phi, omega, theta)) \\
\hspace*{0.27 in} \} \\
MyData <- list(L.P=L.P, L.Q=L.Q, PGF=PGF, P=P, Q=Q, T=T, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\
\hspace*{0.27 in} pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} phi <- parm[Data$pos.phi] \\
\hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.omega] <- omega \\
\hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], 1e-10, 1-1e-5) \\
\hspace*{0.27 in} parm[Data$pos.theta] <- theta \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\
\hspace*{0.27 in} theta.prior <- sum(dunif(theta, 1e-10, 1-1e-5, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- rep(alpha, Data$T) \\
\hspace*{0.27 in} for (p in 1:Data$P) \\
\hspace*{0.62 in} mu[-c(1:Data$L.P[p])] <- mu[-c(1:Data$L.P[p])] + \\
\hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L.P[p])] \\
\hspace*{0.27 in} epsilon <- Data$y - mu \\
\hspace*{0.27 in} sigma2 <- rep(omega, Data$T) \\
\hspace*{0.27 in} for (q in 1:Data$Q) \\
\hspace*{0.62 in} sigma2[-c(1:Data$L.Q[q])] <- sigma2[-c(1:Data$L.Q[q])] + \\
\hspace*{0.95 in} theta[q]*epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 \\
\hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L.P[Data$P])], \\
\hspace*{0.62 in} mu[-c(1:Data$L.P[Data$P])], sigma2[-c(1:Data$L.P[Data$P])], \\
\hspace*{0.62 in} log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + omega.prior + theta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \}
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,P+1), 1, rep(0.5,Q))}

\section{AR(p)-ARCH(q)-M} \label{arparchqm}
\subsection{Form}
$$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=1,\dots,T$$
$$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p} + \delta \sigma^2_{t-1}, \quad t=1,\dots,T$$
$$\epsilon_t = \textbf{y}_t - \mu_t$$
$$\alpha \sim \mathcal{N}(0, 1000)$$
$$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$
$$\delta \sim \mathcal{N}(0, 1000)$$
$$\sigma^2_t = \omega + \sum^Q_{q=1} \theta_q \epsilon^2_{t-q}, \quad t=2,\dots,T$$
$$\omega \sim \mathcal{HC}(25)$$
$$\theta_q \sim \mathcal{U}(0, 1), \quad q=1,\dots,Q$$
\subsection{Data}
\code{data(demonfx) \\
y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\
T <- length(y) \\
L.P <- c(1,5,20) \#Autoregressive lags \\
L.Q <- c(1,2) \#Volatility lags \\
P <- length(L.P) \#Autoregressive order \\
Q <- length(L.Q) \#Volatility order \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), delta=0, omega=0, \\
\hspace*{0.27 in} theta=rep(0,Q))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.delta <- grep("delta", parm.names) \\
pos.omega <- grep("omega", parm.names) \\
pos.theta <- grep("theta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(1) \\
\hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\
\hspace*{0.27 in} delta <- rnorm(1) \\
\hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\
\hspace*{0.27 in} theta <- runif(Data$Q, 1e-10, 1-1e-5) \\
\hspace*{0.27 in} return(c(alpha, phi, delta, omega, theta)) \\
\hspace*{0.27 in} \} \\
MyData <- list(L.P=L.P, L.Q=L.Q, PGF=PGF, P=P, Q=Q, T=T, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\
\hspace*{0.27 in} pos.delta=pos.delta, pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} phi <- parm[Data$pos.phi] \\
\hspace*{0.27 in} delta <- parm[Data$pos.delta] \\
\hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.omega] <- omega \\
\hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], 1e-10, 1-1e-5) \\
\hspace*{0.27 in} parm[Data$pos.theta] <- theta \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} delta.prior <- dnormv(delta, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\
\hspace*{0.27 in} theta.prior <- sum(dunif(theta, 1e-10, 1-1e-5, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- rep(alpha, Data$T) \\
\hspace*{0.27 in} for (p in 1:Data$P) \\
\hspace*{0.62 in} mu[-c(1:Data$L.P[p])] <- mu[-c(1:Data$L.P[p])] + \\
\hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L.P[p])] \\
\hspace*{0.27 in} epsilon <- Data$y - mu \\
\hspace*{0.27 in} sigma2 <- rep(omega, Data$T) \\
\hspace*{0.27 in} for (q in 1:Data$Q) \\
\hspace*{0.62 in} sigma2[-c(1:Data$L.Q[q])] <- sigma2[-c(1:Data$L.Q[q])] + \\
\hspace*{0.95 in} theta[q]*epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 \\
\hspace*{0.27 in} mu <- mu + delta*sigma2 \\
\hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L.P[Data$P])], \\
\hspace*{0.62 in} mu[-c(1:Data$L.P[Data$P])], sigma2[-c(1:Data$L.P[Data$P])], \\
\hspace*{0.62 in} log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + delta.prior + omega.prior + \\
\hspace*{0.62 in} theta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm) \\
\hspace*{0.62 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,P+2), 1, rep(0.5,Q))}

\section{AR(p)-GARCH(1,1)} \label{arpgarch}
\subsection{Form}
$$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=1,\dots,T$$
$$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p}, \quad t=1,\dots,T$$
$$\epsilon_t = \textbf{y}_t - \mu_t$$
$$\alpha \sim \mathcal{N}(0, 1000)$$
$$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$
$$\sigma^2_t = \theta_1 + \theta_2 \epsilon^2_{t-1} + \theta_3 \sigma^2_{t-1}$$
$$\omega \sim \mathcal{HC}(25)$$
$$\theta_k = \frac{1}{1 + \exp(-\theta_k)}, \quad k=1,\dots,3$$
$$\theta_k \sim \mathcal{N}(0, 1000) \in [-10,10], \quad k=1,\dots,3$$
\subsection{Data}
\code{data(demonfx) \\
y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\
T <- length(y) \\
L <- c(1,5,20) \#Autoregressive lags \\
P <- length(L) \#Autoregressive order \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), omega=0, \\
\hspace*{0.27 in} theta=rep(0,2))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.omega <- grep("omega", parm.names) \\
pos.theta <- grep("theta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(1) \\
\hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\
\hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\
\hspace*{0.27 in} theta <- runif(2, 1e-10, 1-1e-5) \\
\hspace*{0.27 in} return(c(alpha, phi, omega, theta)) \\
\hspace*{0.27 in} \} \\
MyData <- list(L=L, P=P, PGF=PGF, T=T, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\
\hspace*{0.27 in} pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} phi <- parm[Data$pos.phi] \\
\hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.omega] <- omega \\
\hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], 1e-10, 1-1e-5) \\
\hspace*{0.27 in} if(sum(theta) >= 1) theta[2] <- 1 - 1e-5 - theta[1] \\
\hspace*{0.27 in} parm[Data$pos.theta] <- theta \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\
\hspace*{0.27 in} theta.prior <- sum(dunif(theta, 0, 1, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- rep(alpha, Data$T) \\
\hspace*{0.27 in} for (p in 1:Data$P) \\
\hspace*{0.62 in} mu[-c(1:Data$L[p])] <- mu[-c(1:Data$L[p])] + \\
\hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L[p])] \\
\hspace*{0.27 in} epsilon <- Data$y - mu \\
\hspace*{0.27 in} sigma2 <- c(omega, omega + theta[1]*epsilon[-Data$T]\textasciicircum 2) \\
\hspace*{0.27 in} sigma2[-1] <- sigma2[-1] + theta[2]*sigma2[-Data$T] \\
\hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L[Data$P])], \\
\hspace*{0.62 in} mu[-c(1:Data$L[Data$P])], sigma2[-c(1:Data$L[Data$P])], \\
\hspace*{0.95 in} log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + omega.prior + theta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm)\\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(0, rep(0,P), rep(0.4,3))}

\section{AR(p)-GARCH(1,1)-M} \label{arpgarchm}
\subsection{Form}
$$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=1,\dots,T$$
$$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p} + \delta \sigma^2_{t-1}, \quad t=1,\dots,(T+1)$$
$$\epsilon_t = \textbf{y}_t - \mu_t$$
$$\alpha \sim \mathcal{N}(0, 1000)$$
$$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$
$$\sigma^2_t = \omega + \theta_1 \epsilon^2_{t-1} + \theta_2 \sigma^2_{t-1}$$
$$\omega \sim \mathcal{HC}(25)$$
$$\theta_k \sim \mathcal{U}(0, 1), \quad k=1,\dots,2$$
\subsection{Data}
\code{data(demonfx) \\
y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\
T <- length(y) \\
L <- c(1,5,20) \#Autoregressive lags \\
P <- length(L) \#Autoregressive order \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=0, delta=0, phi=rep(0,P), omega=0, \\
\hspace*{0.27 in} theta=rep(0,2))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.delta <- grep("delta", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.omega <- grep("omega", parm.names) \\
pos.theta <- grep("theta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(1) \\
\hspace*{0.27 in} delta <- rnorm(1) \\
\hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\
\hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\
\hspace*{0.27 in} theta <- runif(2, 1e-10, 1-1e-5) \\
\hspace*{0.27 in} return(c(alpha, delta, phi, omega, theta)) \\
\hspace*{0.27 in} \} \\
MyData <- list(L=L, P=P, PGF=PGF, T=T, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.delta=pos.delta, \\
\hspace*{0.27 in} pos.phi=pos.phi, pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} delta <- parm[Data$pos.delta] \\
\hspace*{0.27 in} phi <- parm[Data$pos.phi] \\
\hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.omega] <- omega \\
\hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], 1e-10, 1-1e-5) \\
\hspace*{0.27 in} if(sum(theta) >= 1) theta[2] <- 1 - 1e-5 - theta[1] \\
\hspace*{0.27 in} parm[Data$pos.theta] <- theta \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} delta.prior <- dnormv(delta, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\
\hspace*{0.27 in} theta.prior <- sum(dunif(theta, 0, 1, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- rep(alpha, Data$T) \\
\hspace*{0.27 in} for (p in 1:Data$P) \\
\hspace*{0.62 in} mu[-c(1:Data$L[p])] <- mu[-c(1:Data$L[p])] + \\
\hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L[p])] \\
\hspace*{0.27 in} epsilon <- Data$y - mu \\
\hspace*{0.27 in} sigma2 <- c(omega, omega + theta[1]*epsilon[-Data$T]\textasciicircum 2) \\
\hspace*{0.27 in} sigma2[-1] <- sigma2[-1] + theta[2]*sigma2[-Data$T] \\
\hspace*{0.27 in} mu <- mu + delta*sigma2 \\
\hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L[Data$P])], \\
\hspace*{0.62 in} mu[-c(1:Data$L[Data$P])], sigma2[-c(1:Data$L[Data$P])], \\
\hspace*{0.62 in} log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + delta.prior + phi.prior + omega.prior +  \\
\hspace*{0.62 in} theta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,2), rep(0,P), rep(0.4,3))}

\section{AR(p)-TARCH(q)} \label{arptarchq}
\subsection{Form}
$$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=2,\dots,T$$
$$\mu_t = \alpha + \phi^P_{p=1} \textbf{y}_{t-p}, \quad t=(p+1),\dots,T$$
$$\epsilon = \textbf{y} - \mu$$
$$\delta = (\epsilon > 0) \times 1$$
$$\sigma^2_t = \omega + \sum^Q_{q=1} \theta_{q,1} \delta_{t-1} \epsilon^2_{t-1} + \theta_{q,2} (1-\delta_{t-1}) \epsilon^2_{t-1}$$
$$\alpha \sim \mathcal{N}(0, 1000)$$
$$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$
$$\omega \sim \mathcal{HC}(25)$$
$$\theta_{q,j} \sim \mathcal{U}(0, 1), \quad q=1\dots,Q, \quad j=1,\dots,2$$
\subsection{Data}
\code{data(demonfx) \\
y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\
T <- length(y) \\
L.P <- c(1,5,20) \#Autoregressive lags \\
L.Q <- c(1,2) \#Volatility lags \\
P <- length(L.P) \#Autoregressive order \\
Q <- length(L.Q) \#Volatility order \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), omega=0, \\
\hspace*{0.27 in} theta=matrix(0,Q,2))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.omega <- grep("omega", parm.names) \\
pos.theta <- grep("theta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(1) \\
\hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\
\hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\
\hspace*{0.27 in} theta <- runif(Data$Q*2, 1e-10, 1-1e-5) \\
\hspace*{0.27 in} return(c(alpha, phi, omega, theta)) \\
\hspace*{0.27 in} \} \\
MyData <- list(L.P=L.P, L.Q=L.Q, PGF=PGF, P=P, Q=Q, T=T, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\
\hspace*{0.27 in} pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} phi <- parm[Data$pos.phi] \\
\hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.omega] <- omega \\
\hspace*{0.27 in} theta <- matrix(interval(parm[Data$pos.theta], 1e-10, 1-1e-5), Data$Q, \\
\hspace*{0.62 in} 2) \\
\hspace*{0.27 in} parm[Data$pos.theta] <- as.vector(theta) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\
\hspace*{0.27 in} theta.prior <- sum(dunif(theta, 1e-10, 1-1e-5, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- rep(alpha, Data$T) \\
\hspace*{0.27 in} for (p in 1:Data$P) \\
\hspace*{0.62 in} mu[-c(1:Data$L.P[p])] <- mu[-c(1:Data$L.P[p])] + \\
\hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L.P[p])] \\
\hspace*{0.27 in} epsilon <- Data$y - mu \\
\hspace*{0.27 in} delta <- (epsilon > 0) * 1 \\
\hspace*{0.27 in} sigma2 <- rep(omega, Data$T) \\
\hspace*{0.27 in} for (q in 1:Data$Q) \\
\hspace*{0.62 in} sigma2[-c(1:Data$L.Q[q])] <- sigma2[-c(1:Data$L.Q[q])] + \\
\hspace*{0.95 in} delta[1:(Data$T-Data$L.Q[q])] * theta[q,1] * \\
\hspace*{0.95 in} epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 + \\
\hspace*{0.95 in} (1 - delta[1:(Data$T-Data$L.Q[q])]) * theta[q,2] * \\
\hspace*{0.95 in} epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 \\
\hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L.P[Data$P])], \\
\hspace*{0.62 in} mu[-c(1:Data$L.P[Data$P])], sigma2[-c(1:Data$L.P[Data$P])], \\
\hspace*{0.62 in} log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + omega.prior + theta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(0, rep(0,P), 1, rep(0.5,Q*2))}

\section{AR(p)-TARCH(q)-M} \label{arptarchqm}
\subsection{Form}
$$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_t), \quad t=2,\dots,T$$
$$\mu_t = \alpha + \phi^P_{p=1} \textbf{y}_{t-p} + \delta_{t-1} \gamma_1 \sigma^2_{t-1} + (1 - \delta_{t-1}) \gamma_2 \sigma^2_{t-1}, \quad t=(p+1),\dots,T$$
$$\epsilon = \textbf{y} - \mu$$
$$\delta = (\epsilon > 0) \times 1$$
$$\sigma^2_t = \omega + \sum^Q_{q=1} \theta_{q,1} \delta_{t-1} \epsilon^2_{t-1} + \theta_{q,2} (1-\delta_{t-1}) \epsilon^2_{t-1}$$
$$\alpha \sim \mathcal{N}(0, 1000)$$
$$\gamma_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,2$$
$$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$
$$\omega \sim \mathcal{HC}(25)$$
$$\theta_{q,j} \sim \mathcal{U}(0, 1), \quad q=1\dots,Q, \quad j=1,\dots,2$$
\subsection{Data}
\code{data(demonfx) \\
y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\
T <- length(y) \\
L.P <- c(1,5,20) \#Autoregressive lags \\
L.Q <- c(1,2) \#Volatility lags \\
P <- length(L.P) \#Autoregressive order \\
Q <- length(L.Q) \#Volatility order \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=0, gamma=rep(0,2), phi=rep(0,P), \\
\hspace*{0.27 in} omega=0, theta=matrix(0,Q,2))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.omega <- grep("omega", parm.names) \\
pos.theta <- grep("theta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(1) \\
\hspace*{0.27 in} gamma <- rnorm(2) \\
\hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\
\hspace*{0.27 in} omega <- rhalfcauchy(1,5) \\
\hspace*{0.27 in} theta <- runif(Data$Q*2, 1e-10, 1-1e-5) \\
\hspace*{0.27 in} return(c(alpha, gamma, phi, omega, theta)) \\
\hspace*{0.27 in} \} \\
MyData <- list(L.P=L.P, L.Q=L.Q, PGF=PGF, P=P, Q=Q, T=T, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.gamma=pos.gamma, \\
\hspace*{0.27 in} pos.phi=pos.phi, pos.omega=pos.omega, pos.theta=pos.theta, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\
\hspace*{0.27 in} phi <- parm[Data$pos.phi] \\
\hspace*{0.27 in} omega <- interval(parm[Data$pos.omega], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.omega] <- omega \\
\hspace*{0.27 in} theta <- matrix(interval(parm[Data$pos.theta], 1e-10, 1-1e-5), Data$Q, \\
\hspace*{0.62 in} 2) \\
\hspace*{0.27 in} parm[Data$pos.theta] <- as.vector(theta) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} omega.prior <- dhalfcauchy(omega, 25, log=TRUE) \\
\hspace*{0.27 in} theta.prior <- sum(dunif(theta, 1e-10, 1-1e-5, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- rep(alpha, Data$T) \\
\hspace*{0.27 in} for (p in 1:Data$P) \\
\hspace*{0.62 in} mu[-c(1:Data$L.P[p])] <- mu[-c(1:Data$L.P[p])] + \\
\hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L.P[p])] \\
\hspace*{0.27 in} epsilon <- Data$y - mu \\
\hspace*{0.27 in} delta <- (epsilon > 0) * 1 \\
\hspace*{0.27 in} sigma2 <- rep(omega, Data$T) \\
\hspace*{0.27 in} for (q in 1:Data$Q) \\
\hspace*{0.62 in} sigma2[-c(1:Data$L.Q[q])] <- sigma2[-c(1:Data$L.Q[q])] + \\
\hspace*{0.95 in} delta[1:(Data$T-Data$L.Q[q])] * theta[q,1] * \\
\hspace*{0.95 in} epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 + \\
\hspace*{0.95 in} (1 - delta[1:(Data$T-Data$L.Q[q])]) * theta[q,2] * \\
\hspace*{0.95 in} epsilon[1:(Data$T-Data$L.Q[q])]\textasciicircum 2 \\
\hspace*{0.27 in} mu <- mu + delta*gamma[1]*sigma2 + (1 - delta)*gamma[2]*sigma2 \\
\hspace*{0.27 in} LL <- sum(dnormv(Data$y[-c(1:Data$L.P[Data$P])], \\
\hspace*{0.62 in} mu[-c(1:Data$L.P[Data$P])], sigma2[-c(1:Data$L.P[Data$P])], \\
\hspace*{0.62 in} log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + gamma.prior + phi.prior + omega.prior + \\
\hspace*{0.62 in} theta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnormv(length(mu), mu, sigma2), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,3), rep(0,P), 1, rep(0.5,Q*2))}

\section{Autoregressive Moving Average, ARMA(p,q)} \label{armapq}
\subsection{Form}
$$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2), \quad t=1,\dots,T$$
$$\mu_t = \alpha + \sum^P_{p=1} \phi_p \textbf{y}_{t-p} + \sum^Q_{q=1} \theta_q \epsilon_{t-q}$$
$$\epsilon_t = \textbf{y}_t - \mu_t$$
$$\alpha \sim \mathcal{N}(0, 1000)$$
$$\phi_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$
$$\sigma \sim \mathcal{HC}(25)$$
$$\theta_q \sim \mathcal{N}(0, 1000), \quad q=1,\dots,Q$$
\subsection{Data}
\code{data(demonfx) \\
y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\
T <- length(y) \\
L.P <- c(1,5,20) \#Autoregressive lags \\
L.Q <- c(1,2) \#Moving average lags \\
P <- length(L.P) \#Autoregressive order \\
Q <- length(L.Q) \#Moving average order \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=0, phi=rep(0,P), sigma=0, \\
\hspace*{0.27 in} theta=rep(0,Q))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
pos.theta <- grep("theta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(1) \\
\hspace*{0.27 in} phi <- runif(Data$P,-1,1) \\
\hspace*{0.27 in} sigma <- rhalfcauchy(1,5) \\
\hspace*{0.27 in} theta <- rnorm(Data$Q) \\
\hspace*{0.27 in} return(c(alpha, phi, sigma, theta)) \\
\hspace*{0.27 in} \} \\
MyData <- list(L.P=L.P, L.Q=L.Q, PGF=PGF, P=P, Q=Q, T=T, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.phi=pos.phi, \\
\hspace*{0.27 in} pos.sigma=pos.sigma, pos.theta=pos.theta, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} phi <- parm[Data$pos.phi] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} theta <- parm[Data$pos.theta] \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} theta.prior <- sum(dnormv(theta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- rep(alpha, Data$T) \\
\hspace*{0.27 in} for (p in 1:Data$P) \\
\hspace*{0.62 in} mu[-c(1:Data$L.P[p])] <- mu[-c(1:Data$L.P[p])] + \\
\hspace*{0.95 in} phi[p]*Data$y[1:(Data$T-Data$L.P[p])] \\
\hspace*{0.27 in} epsilon <- Data$y - mu \\
\hspace*{0.27 in} for (q in 1:Data$Q) \\
\hspace*{0.62 in} mu[-c(1:Data$L.Q[q])] <- mu[-c(1:Data$L.Q[q])] + \\
\hspace*{0.95 in} theta[q]*epsilon[1:(Data$T-Data$L.Q[q])] \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y[-c(1:Data$L.P[Data$P])], \\
\hspace*{0.62 in} mu[-c(1:Data$L.P[Data$P])], sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + sigma.prior + theta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(0, rep(0,P), 1, rep(0,Q))}

\section{Beta Regression} \label{beta.reg}
\subsection{Form}
$$\textbf{y} \sim \mathcal{BETA}(a,b)$$
$$a = \mu \phi$$
$$b = (1 - \mu) \phi$$
$$\mu = \Phi(\beta_1 + \beta_2 \textbf{x}), \quad \mu \in (0, 1)$$
$$\beta_j \sim \mathcal{N}(0, 10), \quad j=1,\dots,J$$
$$\phi \sim \mathcal{HC}(25)$$
where $\Phi$ is the normal CDF.
\subsection{Data}
\code{N <- 100 \\
x <- runif(N) \\
y <- rbeta(N, (0.5-0.2*x)*3, (1-(0.5-0.2*x))*3)
mon.names <- "LP" \\
parm.names <- c("beta[1]","beta[2]","phi") \\
pos.beta <- grep("beta", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
PGF <- function(Data) return(c(rnormv(2,0,10), rhalfcauchy(1,5))) \\
MyData <- list(PGF=PGF, mon.names=mon.names, parm.names=parm.names, \\
\hspace*{0.27 in} pos.beta=pos.beta, pos.phi=pos.phi, x=x, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1e-100, Inf) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 10, log=TRUE)) \\
\hspace*{0.27 in} phi.prior <- dhalfcauchy(phi, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- interval(pnorm(beta[1] + beta[2]*Data$x), 0.001, 0.999, \\
\hspace*{0.62 in} reflect=FALSE) \\
\hspace*{0.27 in} a <- mu * phi \\
\hspace*{0.27 in} b <- (1 - mu) * phi \\
\hspace*{0.27 in} LL <- sum(dbeta(Data$y, a, b, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + phi.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rbeta(length(mu), a, b), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,2), 0.01)}

\section{Beta-Binomial} \label{beta.binomial}
\subsection{Form}
$$\textbf{y}_i \sim \mathcal{BIN}(\textbf{n}_i, \pi_i), \quad i=1,\dots,N$$
$$\pi_i \sim \mathcal{BETA}(\alpha, \beta) \in [0.001,0.999]$$
\subsection{Data}
\code{N <- 20 \\
n <- round(runif(N, 50, 100)) \\
y <- round(runif(N, 1, 10)) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(pi=rep(0,N))) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} pi <- rbeta(Data$N,1,1) \\
\hspace*{0.27 in} return(pi) \\
\hspace*{0.27 in} \} \\
MyData <- list(N=N, PGF=PGF, mon.names=mon.names, n=n, \\
\hspace*{0.27 in} parm.names=parm.names, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} parm[1:Data$N] <- pi <- interval(parm[1:Data$N], 0.001, 0.999) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} pi.prior <- sum(dbeta(pi, 1, 1, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} LL <- sum(dbinom(Data$y, Data$n, pi, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + pi.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rbinom(Data$N, Data$n, pi), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0.5,N))}

\section{Binary Logit} \label{binary.logit}
\subsection{Form}
$$\textbf{y} \sim \mathcal{BERN}(\eta)$$
$$\eta = \frac{1}{1 + \exp(-\mu)}$$
$$\mu = \textbf{X} \beta$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
\subsection{Data}
\code{data(demonsnacks) \\
J <- 3 \\
y <- ifelse(demonsnacks$Calories <= 137, 0, 1) \\
X <- cbind(1, as.matrix(demonsnacks[,c(7,8)])) \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J))) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} return(beta) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[1:Data$J] \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} eta <- invlogit(mu) \\
\hspace*{0.27 in} LL <- sum(dbern(Data$y, eta, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rbern(length(eta), eta), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- rep(0,J)}

\section{Binary Log-Log Link Mixture} \label{binary.loglog.mixture}
A weighted mixture of the log-log and complementary log-log link functions is used, where $\alpha$ is the weight. Since the log-log and complementary log-log link functions are asymmetric (as opposed to the symmetric logit and probit link functions), it may be unknown \textit{a priori} whether the log-log or complementary log-log will perform better. 
\subsection{Form}
$$\textbf{y} \sim \mathcal{BERN}(\eta)$$
$$\eta = \alpha \exp(-\exp(\mu)) + (1 - \alpha) (1 - \exp(-\exp(\mu)))$$
$$\mu = \textbf{X} \beta$$
$$\alpha \sim \mathcal{U}(0, 1)$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
\subsection{Data}
\code{N <- 100 \\
J <- 3 \\
X <- cbind(1, matrix(rnorm(N*(J-1),N,J-1))) \\
alpha <- runif(1) \\
beta <- rnorm(J) \\
mu <- tcrossprod(X, t(beta)) \\
eta <- alpha*invloglog(mu) + (1-alpha)*invcloglog(mu) \\
y <- rbern(N, eta) \\
mon.names <- c("LP","alpha") \\
parm.names <- as.parm.names(list(beta=rep(0,J), logit.alpha=0)) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} logit.alpha <- rnorm(1) \\
\hspace*{0.27 in} return(c(beta, logit.alpha)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} parm[Data$J+1] <- alpha <- interval(parm[Data$J+1], -700, 700) \\
\hspace*{0.27 in} beta <- parm[1:Data$J] \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dunif(alpha, 0, 1, log=TRUE) \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} eta <- alpha*invloglog(mu) + (1-alpha)*invcloglog(mu) \\
\hspace*{0.27 in} LL <- sum(dbern(Data$y, eta, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,alpha), \\
\hspace*{0.62 in} yhat=rbern(length(eta), eta), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 0)}

\section{Binary Probit} \label{binary.probit}
\subsection{Form}
$$\textbf{y} \sim \mathcal{BERN}(\textbf{p})$$
$$\textbf{p} = \phi(\mu)$$
$$\mu = \textbf{X} \beta \in [-10,10]$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
where $\phi$ is the CDF of the standard normal distribution, and $J$=3.
\subsection{Data}
\code{data(demonsnacks) \\
J <- 3 \\
y <- ifelse(demonsnacks$Calories <= 137, 0, 1) \\
X <- cbind(1, as.matrix(demonsnacks[,c(7,8)])) \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J))) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} return(beta) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[1:Data$J] \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} mu <- interval(mu, -10, 10, reflect=FALSE) \\
\hspace*{0.27 in} p <- pnorm(mu) \\
\hspace*{0.27 in} LL <- sum(dbern(Data$y, p, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rbern(length(p), p), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- rep(0,J)}

\section{Binary Robit} \label{binary.robit}
\subsection{Form}
$$\textbf{y} \sim \mathcal{BERN}(\textbf{p})$$
$$\textbf{p} = \textbf{T}_\nu(\mu)$$
$$\mu = \textbf{X} \beta \in [-10,10]$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\nu \sim \mathcal{U}(5, 10)$$
where $\textbf{T}_\nu$ is the CDF of the standard t-distribution with $\nu$ degrees of freedom.
\subsection{Data}
\code{data(demonsnacks) \\
y <- ifelse(demonsnacks$Calories <= 137, 0, 1) \\
X <- cbind(1, as.matrix(demonsnacks[,c(7,8)])) \\
J <- ncol(X) \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), nu=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.nu <- grep("nu", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} nu <- runif(1,5,10) \\
\hspace*{0.27 in} return(c(beta, nu)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.nu=pos.nu, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, 1000) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} nu.prior <- dunif(nu, 1e-100, 1000, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} mu <- interval(mu, -10, 10, reflect=FALSE) \\
\hspace*{0.27 in} p <- pst(mu, nu=nu) \\
\hspace*{0.27 in} LL <- sum(dbern(Data$y, p, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + nu.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rbern(length(p), p), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \}
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 5)}

\section{Binomial Logit} \label{binomial.logit}
\subsection{Form}
$$\textbf{y} \sim \mathcal{BIN}(\textbf{p}, \textbf{n})$$
$$\textbf{p} = \frac{1}{1 + \exp(-\mu)}$$
$$\mu = \beta_1 + \beta_2 \textbf{x}$$
$$\beta_j \sim \mathcal{N}(0,1000), \quad j=1,\dots,J$$
\subsection{Data}
\code{\#10 Trials \\
exposed <- c(100,100,100,100,100,100,100,100,100,100) \\
deaths <- c(10,20,30,40,50,60,70,80,90,100) \\
dose <- c(1,2,3,4,5,6,7,8,9,10) \\
J <- 2 \#Number of parameters \\
mon.names <- "LP" \\
parm.names <- c("beta[1]","beta[2]") \\
PGF <- function(Data) return(rnormv(Data$J,0,1000)) \\
MyData <- list(J=J, PGF=PGF, n=exposed, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, x=dose, y=deaths)
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[1:Data$J] \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- beta[1] + beta[2]*Data$x \\
\hspace*{0.27 in} p <- invlogit(mu) \\
\hspace*{0.27 in} LL <- sum(dbinom(Data$y, Data$n, p, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rbinom(length(p), Data$n, p), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- rep(0,J)}

\section{Binomial Probit} \label{binomial.probit}
\subsection{Form}
$$\textbf{y} \sim \mathcal{BIN}(\textbf{p}, \textbf{n})$$
$$\textbf{p} = \phi(\mu)$$
$$\mu = \beta_1 + \beta_2 \textbf{x} \in [-10,10]$$
$$\beta_j \sim \mathcal{N}(0,1000), \quad j=1,\dots,J$$
where $\phi$ is the CDF of the standard normal distribution, and $J$=2.
\subsection{Data}
\code{\#10 Trials \\
exposed <- c(100,100,100,100,100,100,100,100,100,100) \\
deaths <- c(10,20,30,40,50,60,70,80,90,100) \\
dose <- c(1,2,3,4,5,6,7,8,9,10) \\
J <- 2 \#Number of parameters \\
mon.names <- "LP" \\
parm.names <- c("beta[1]","beta[2]") \\
PGF <- function(Data) return(rnormv(Data$J,0,1000)) \\
MyData <- list(J=J, PGF=PGF, n=exposed, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, x=dose, y=deaths) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[1:Data$J] \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- beta[1] + beta[2]*Data$x \\
\hspace*{0.27 in} mu <- interval(mu, -10, 10, reflect=FALSE) \\
\hspace*{0.27 in} p <- pnorm(mu) \\
\hspace*{0.27 in} LL <- sum(dbinom(Data$y, Data$n, p, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rbinom(length(p), Data$n, p), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- rep(0,J)}

\section{Binomial Robit} \label{binomial.robit}
\subsection{Form}
$$\textbf{y} \sim \mathcal{BIN}(\textbf{p}, \textbf{n})$$
$$\textbf{p} = \textbf{T}_\nu(\mu)$$
$$\mu = \beta_1 + \beta_2 \textbf{x} \in [-10,10]$$
$$\beta_j \sim \mathcal{N}(0,1000), \quad j=1,\dots,J$$
$$\nu \sim \mathcal{U}(5, 10)$$ 
where $\textbf{T}_\nu$ is the CDF of the standard t-distribution with $\nu$ degrees of freedom.
\subsection{Data}
\code{\#10 Trials \\
exposed <- c(100,100,100,100,100,100,100,100,100,100) \\
deaths <- c(10,20,30,40,50,60,70,80,90,100) \\
dose <- c(1,2,3,4,5,6,7,8,9,10) \\
J <- 2 \#Number of parameters \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,2), nu=0)) \\
PGF <- function(Data) return(c(rnormv(Data$J,0,1000), runif(1,5,10))) \\
MyData <- list(J=J, PGF=PGF, n=exposed, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, x=dose, y=deaths) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[1:Data$J] \\
\hspace*{0.27 in} parm[Data$J+1] <- nu <- interval(parm[Data$J+1], 5, 10) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} nu.prior <- dunif(nu, 5, 10, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- beta[1] + beta[2]*Data$x \\
\hspace*{0.27 in} mu <- interval(mu, -10, 10, reflect=FALSE) \\
\hspace*{0.27 in} p <- pst(mu, nu=nu) \\
\hspace*{0.27 in} LL <- sum(dbinom(Data$y, Data$n, p, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + nu.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rbinom(length(p), Data$n, p), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 5)}

\section{Change Point Regression} \label{changepoint}
This example uses a popular variant of the stagnant water data set.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu = \alpha + \beta_1 \textbf{x} + \beta_2 (\textbf{x} - \theta)[(\textbf{x} - \theta) > 0]$$
$$\alpha \sim \mathcal{N}(0, 1000)$$
$$\beta \sim \mathcal{N}(0, 1000)$$
$$\sigma \sim \mathcal{HC}(25)$$
$$\theta \sim \mathcal{U}(-1.3, 1.1)$$
\subsection{Data}
\code{N <- 29 \\
y <- c(1.12, 1.12, 0.99, 1.03, 0.92, 0.90, 0.81, 0.83, 0.65, 0.67, 0.60, \\
\hspace*{0.27 in} 0.59, 0.51, 0.44, 0.43, 0.43, 0.33, 0.30, 0.25, 0.24, 0.13, -0.01, \\
\hspace*{0.27 in} -0.13, -0.14, -0.30, -0.33, -0.46, -0.43, -0.65) \\
x <- c(-1.39, -1.39, -1.08, -1.08, -0.94, -0.80, -0.63, -0.63, -0.25, -0.25, \\
\hspace*{0.27 in} -0.12, -0.12, 0.01, 0.11, 0.11, 0.11, 0.25, 0.25, 0.34, 0.34, 0.44, \\
\hspace*{0.27 in} 0.59, 0.70, 0.70, 0.85, 0.85, 0.99, 0.99, 1.19) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=0, beta=rep(0,2), sigma=0, theta=0)) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
pos.theta <- grep("theta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(1) \\
\hspace*{0.27 in} beta <- rnorm(2) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} theta <- runif(1) \\
\hspace*{0.27 in} return(c(alpha, beta, sigma, theta)) \\
\hspace*{0.27 in} \} \\
MyData <- list(N=N, PGF=PGF, mon.names=mon.names, parm.names=parm.names, \\
\hspace*{0.27 in} pos.alpha=pos.alpha, pos.beta=pos.beta, pos.sigma=pos.sigma, \\
\hspace*{0.27 in} pos.theta=pos.theta, x=x, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], -1.3, 1.1) \\
\hspace*{0.27 in} parm[Data$pos.theta] <- theta \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} theta.prior <- dunif(theta, -1.3, 1.1, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- alpha + beta[1]*x + beta[2]*(x - theta)*{(x - theta) > 0} \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + sigma.prior + theta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(0.2, -0.45, 0, 0.2, 0)}

\section{Cluster Analysis, Confirmatory (CCA)} \label{cca}
This is a parametric, model-based, cluster analysis, also called a finite mixture model or latent class cluster analysis, where the number of clusters $C$ is fixed. When the number of clusters is unknown, exploratory cluster analysis should be used. The record-level cluster membership parameter vector, $\theta$, is a vector of discrete parameters. Discrete parameters are not supported in all algorithms. The example below is updated with the Slice sampler.
\subsection{Form}
$$\textbf{Y}_{i,j} \sim \mathcal{N}(\mu_{\theta[i],j}, \sigma^2_{\theta[i]}), \quad i=1,\dots,N, \quad j=1,\dots,J$$
$$\theta_i \sim \mathcal{CAT}(\pi_{1:C}), \quad i=1,\dots,N$$
$$\pi_{1:C} \sim \mathcal{D}(\alpha_{1:C})$$
$$\alpha_c = 1$$
$$\mu_{c,j} \sim \mathcal{N}(0, \nu^2_c), \quad c=1,\dots,C, \quad j=1,\dots,J$$
$$\sigma_c \sim \mathcal{HC}(25), \quad c=1,\dots,C$$
$$\nu_c \sim \mathcal{HC}(25), \quad c=1,\dots,C$$
\subsection{Data}
\code{data(demonsnacks) \\
Y <- as.matrix(log(demonsnacks + 1)) \\
N <- nrow(Y) \\
J <- ncol(Y) \\
for (j in 1:J) Y[,j] <- CenterScale(Y[,j]) \\
C <- 3 \#Number of clusters \\
alpha <- rep(1,C) \#Prior probability of cluster proportion \\
mon.names <- c("LP", paste("pi[", 1:C, "]", sep="")) \\
parm.names <- as.parm.names(list(theta=rep(0,N), mu=matrix(0,C,J), \\
\hspace*{0.27 in} nu=rep(0,C), sigma=rep(0,C))) \\
pos.theta <- grep("theta", parm.names) \\
pos.mu <- grep("mu", parm.names) \\
pos.nu <- grep("nu", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} theta <- rcat(Data$N, p=rep(1/Data$C, Data$C)) \\
\hspace*{0.27 in} mu <- rnorm(Data$J*Data$J) \\
\hspace*{0.27 in} nu <- runif(Data$C) \\
\hspace*{0.27 in} sigma <- runif(Data$C) \\
\hspace*{0.27 in} return(c(theta, mu, nu, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(C=C, J=J, N=N, PGF=PGF, Y=Y, alpha=alpha, \\
\hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.theta=pos.theta, \\
\hspace*{0.27 in} pos.mu=pos.mu, pos.nu=pos.nu, pos.sigma=pos.sigma) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} theta <- parm[Data$pos.theta] \\
\hspace*{0.27 in} mu <- matrix(parm[Data$pos.mu], Data$C, Data$J) \\
\hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\
\hspace*{0.27 in} pi <- rep(0, Data$C) \\
\hspace*{0.27 in} tab <- table(theta) \\
\hspace*{0.27 in} pi[as.numeric(names(tab))] <- as.vector(tab) \\
\hspace*{0.27 in} pi <- pi / sum(pi) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} theta.prior <- sum(dcat(theta, pi, log=TRUE)) \\
\hspace*{0.27 in} mu.prior <- sum(dnorm(mu, 0, matrix(nu, Data$C, Data$J), log=TRUE)) \\
\hspace*{0.27 in} nu.prior <- sum(dhalfcauchy(nu, 25, log=TRUE)) \\
\hspace*{0.27 in} pi.prior <- ddirichlet(pi, Data$alpha, log=TRUE) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu[theta,], sigma[theta], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + theta.prior + mu.prior + nu.prior + pi.prior + \\
\hspace*{0.62 in} sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,pi), \\
\hspace*{0.62 in} yhat=rnorm(prod(dim(mu[theta,])), mu[theta,], sigma[theta]), \\
\hspace*{0.62 in} parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rcat(N,rep(1/C,C)), rep(0,C*J), rep(1,C), rep(1,C))}

\section{Cluster Analysis, Exploratory (ECA)} \label{eca}
This is a nonparametric, model-based, cluster analysis, also called an infinite mixture model or latent class cluster analysis, where the number of clusters $C$ is unknown, and a Dirichlet process via truncated stick-breaking is used to estimated the number of clusters. The record-level cluster membership parameter vector, $\theta$, is a vector of discrete parameters. Discrete parameters are not supported in all algorithms. The example below is updated with the Slice sampler.
\subsection{Form}
$$\textbf{Y}_{i,j} \sim \mathcal{N}(\mu_{\theta[i],j}, \sigma^2_{\theta[i]}), \quad i=1,\dots,N, \quad j=1,\dots,J$$
$$\theta_i \sim \mathcal{CAT}(\pi_{1:C}), \quad i=1,\dots,N$$
$$\mu_{c,j} \sim \mathcal{N}(0, \nu^2_c), \quad c=1,\dots,C, \quad j=1,\dots,J$$
$$\sigma_c \sim \mathcal{HC}(25), \quad c=1,\dots,C$$
$$\pi = \mathrm{Stick}(\delta)$$
$$\delta_c \sim \mathcal{BETA}(1, \gamma), c=1,\dots,(C-1)$$
$$\gamma \sim \mathcal{G}(\alpha, \beta)$$
$$\alpha \sim \mathcal{HC}(25)$$
$$\beta \sim \mathcal{HC}(25)$$
$$\nu_c \sim \mathcal{HC}(25), \quad c=1,\dots,C$$
\subsection{Data}
\code{data(demonsnacks) \\
Y <- as.matrix(log(demonsnacks + 1)) \\
N <- nrow(Y) \\
J <- ncol(Y) \\
for (j in 1:J) Y[,j] <- CenterScale(Y[,j]) \\
C <- 5 \#Maximum number of clusters to explore \\
mon.names <- c("LP", paste("pi[", 1:C, "]", sep="")) \\
parm.names <- as.parm.names(list(theta=rep(0,N), delta=rep(0,C-1), \\
\hspace*{0.27 in} mu=matrix(0,C,J), nu=rep(0,C), sigma=rep(0,C), alpha=0, beta=0, \\
\hspace*{0.27 in} gamma=0)) \\
pos.theta <- grep("theta", parm.names) \\
pos.delta <- grep("delta", parm.names) \\
pos.mu <- grep("mu", parm.names) \\
pos.nu <- grep("nu", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} mu <- rnorm(Data$C*Data$J) \\
\hspace*{0.27 in} nu <- runif(Data$C) \\
\hspace*{0.27 in} sigma <- runif(Data$C) \\
\hspace*{0.27 in} alpha <- runif(1) \\
\hspace*{0.27 in} beta <- runif(1) \\
\hspace*{0.27 in} gamma <- rgamma(1, alpha, beta) \\
\hspace*{0.27 in} delta <- rev(sort(rbeta(Data$C-1, 1, gamma))) \\
\hspace*{0.27 in} theta <- rcat(Data$N, Stick(delta)) \\
\hspace*{0.27 in} return(c(theta, delta, mu, nu, sigma, alpha, beta, gamma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(C=C, J=J, N=N, PGF=PGF, Y=Y, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.theta=pos.theta, pos.delta=pos.delta, \\
\hspace*{0.27 in} pos.mu=pos.mu, pos.nu=pos.nu, pos.sigma=pos.sigma, \\
\hspace*{0.27 in} pos.alpha=pos.alpha, pos.beta=pos.beta, pos.gamma=pos.gamma) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Hyperhyperparameters \\
\hspace*{0.27 in} alpha <- interval(parm[Data$pos.alpha], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.alpha] <- alpha \\
\hspace*{0.27 in} beta <- interval(parm[Data$pos.beta], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.beta] <- beta \\
\hspace*{0.27 in} \#\#\# Hyperparameters \\
\hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], 1e-10, 1-1e-10) \\
\hspace*{0.27 in} parm[Data$pos.delta] <- delta \\
\hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} theta <- parm[Data$pos.theta] \\
\hspace*{0.27 in} mu <- matrix(parm[Data$pos.mu], Data$C, Data$J) \\
\hspace*{0.27 in} pi <- Stick(delta) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Hyperhyperprior \\
\hspace*{0.27 in} alpha.prior <- dhalfcauchy(alpha, 25, log=TRUE) \\
\hspace*{0.27 in} beta.prior <- dhalfcauchy(beta, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Hyperprior \\
\hspace*{0.27 in} delta.prior <- dStick(delta, gamma, log=TRUE) \\
\hspace*{0.27 in} gamma.prior <- dgamma(gamma, alpha, beta, log=TRUE) \\
\hspace*{0.27 in} nu.prior <- sum(dhalfcauchy(nu, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} theta.prior <- sum(dcat(theta, pi, log=TRUE)) \\
\hspace*{0.27 in} mu.prior <- sum(dnorm(mu, 0, matrix(nu, Data$C, Data$J), log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu[theta,], sigma[theta], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + theta.prior + delta.prior + mu.prior + nu.prior + \\
\hspace*{0.62 in} alpha.prior + beta.prior + gamma.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,pi), \\
\hspace*{0.62 in} yhat=rnorm(prod(dim(mu[theta,])), mu[theta,], sigma[theta]), \\
\hspace*{0.62 in} parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rcat(N, rev(sort(rStick(C-1,1)))), rep(0.5,C-1), \\
\hspace*{0.27 in} rep(0,C*J), rep(1,C), rep(1,C), rep(1,3))}

\section{Conditional Autoregression (CAR), Poisson} \label{car.poisson}
This CAR example is a slightly modified form of example 7.3 (Model A) in \citet{congdon03}. The Scottish lip cancer data also appears in the WinBUGS \citep{spiegelhalter03} examples and is a widely analyzed example. The data $\textbf{y}$ consists of counts for $i=1,\dots,56$ counties in Scotland. A single predictor $\textbf{x}$ is provided. The errors, $\epsilon$, are allowed to include spatial effects as smoothing by spatial effects from areal neighbors. The vector $\epsilon_\mu$ is the mean of each area's error, and is a weighted average of errors in contiguous areas. Areal neighbors are indicated in adjacency matrix $\textbf{A}$.
\subsection{Form}
$$\textbf{y} \sim \mathcal{P}(\lambda)$$
$$\lambda = \exp(\log(\textbf{E}) + \beta_1 + \beta_2 \textbf{x} + \epsilon)$$
$$\epsilon \sim \mathcal{N}(\epsilon_\mu, \sigma^2)$$
$$\epsilon_{\mu[i]} = \rho \sum^J_{j=1} \textbf{A}_{i,j} \epsilon_i, \quad i=1,\dots,N$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\rho \sim \mathcal{U}(-1,1)$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{N <- 56 \#Number of areas \\
NN <- 264 \#Number of adjacent areas \\
y <- c(9,39,11,9,15,8,26,7,6,20,13,5,3,8,17,9,2,7,9,7,16,31,11,7,19,15,7, \\
\hspace*{0.27 in} 10,16,11,5,3,7,8,11,9,11,8,6,4,10,8,2,6,19,3,2,3,28,6,1,1,1,1,0,0) \\
E <- c( 1.4,8.7,3.0,2.5,4.3,2.4,8.1,2.3,2.0,6.6,4.4,1.8,1.1,3.3,7.8,4.6, \\
\hspace*{0.27 in} 1.1,4.2,5.5,4.4,10.5,22.7,8.8,5.6,15.5,12.5,6.0,9.0,14.4,10.2,4.8, \\
\hspace*{0.27 in} 2.9,7.0,8.5,12.3,10.1,12.7,9.4,7.2,5.3,18.8,15.8,4.3,14.6,50.7,8.2, \\
\hspace*{0.27 in} 5.6,9.3,88.7,19.6,3.4,3.6,5.7,7.0,4.2,1.8) \#Expected \\
x <- c(16,16,10,24,10,24,10,7,7,16,7,16,10,24,7,16,10,7,7,10,7,16,10,7,1,1, \\
\hspace*{0.27 in} 7,7,10,10,7,24,10,7,7,0,10,1,16,0,1,16,16,0,1,7,1,1,0,1,1,0,1,1,16,10) \\
A <- matrix(0, N, N) \\
A[1,c(5,9,11,19)] <- 1 \#Area 1 is adjacent to areas 5, 9, 11, and 19 \\
A[2,c(7,10)] <- 1 \#Area 2 is adjacent to areas 7 and 10 \\
A[3,c(6,12)] <- 1; A[4,c(18,20,28)] <- 1; A[5,c(1,11,12,13,19)] <- 1 \\
A[6,c(3,8)] <- 1; A[7,c(2,10,13,16,17)] <- 1; A[8,6] <- 1 \\
A[9,c(1,11,17,19,23,29)] <- 1; A[10,c(2,7,16,22)] <- 1 \\
A[11,c(1,5,9,12)] <- 1; A[12,c(3,5,11)] <- 1; A[13,c(5,7,17,19)] <- 1 \\
A[14,c(31,32,35)] <- 1; A[15,c(25,29,50)] <- 1 \\
A[16,c(7,10,17,21,22,29)] <- 1; A[17,c(7,9,13,16,19,29)] <- 1 \\
A[18,c(4,20,28,33,55,56)] <- 1; A[19,c(1,5,9,13,17)] <- 1 \\
A[20,c(4,18,55)] <- 1; A[21,c(16,29,50)] <- 1; A[22,c(10,16)] <- 1 \\
A[23,c(9,29,34,36,37,39)] <- 1; A[24,c(27,30,31,44,47,48,55,56)] <- 1 \\
A[25,c(15,26,29)] <- 1; A[26,c(25,29,42,43)] <- 1 \\
A[27,c(24,31,32,55)] <- 1; A[28,c(4,18,33,45)] <- 1 \\
A[29,c(9,15,16,17,21,23,25,26,34,43,50)] <- 1 \\
A[30,c(24,38,42,44,45,56)] <- 1; A[31,c(14,24,27,32,35,46,47)] <- 1 \\
A[32,c(14,27,31,35)] <- 1; A[33,c(18,28,45,56)] <- 1 \\
A[34,c(23,29,39,40,42,43,51,52,54)] <- 1; A[35,c(14,31,32,37,46)] <- 1 \\
A[36,c(23,37,39,41)] <- 1; A[37,c(23,35,36,41,46)] <- 1 \\
A[38,c(30,42,44,49,51,54)] <- 1; A[39,c(23,34,36,40,41)] <- 1 \\
A[40,c(34,39,41,49,52)] <- 1; A[41,c(36,37,39,40,46,49,53)] <- 1 \\
A[42,c(26,30,34,38,43,51)] <- 1; A[43,c(26,29,34,42)] <- 1 \\
A[44,c(24,30,38,48,49)] <- 1; A[45,c(28,30,33,56)] <- 1 \\
A[46,c(31,35,37,41,47,53)] <- 1; A[47,c(24,31,46,48,49,53)] <- 1 \\
A[48,c(24,44,47,49)] <- 1; A[49,c(38,40,41,44,47,48,52,53,54)] <- 1 \\
A[50,c(15,21,29)] <- 1; A[51,c(34,38,42,54)] <- 1 \\
A[52,c(34,40,49,54)] <- 1; A[53,c(41,46,47,49)] <- 1 \\
A[54,c(34,38,49,51,52)] <- 1; A[55,c(18,20,24,27,56)] <- 1 \\
A[56,c(18,24,30,33,45,55)] <- 1 \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,2), epsilon=rep(0,N), rho=0, \\
\hspace*{0.27 in} sigma=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.epsilon <- grep("epsilon", parm.names) \\
pos.rho <- grep("rho", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(2) \\
\hspace*{0.27 in} epsilon <- rnorm(Data$N) \\
\hspace*{0.27 in} rho <- runif(1,-1,1) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(beta, epsilon, rho, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(A=A, E=E, N=N, PGF=PGF, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.epsilon=pos.epsilon, \\
\hspace*{0.27 in} pos.rho=pos.rho, pos.sigma=pos.sigma, x=x, y=y)
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} epsilon <- parm[Data$pos.epsilon] \\
\hspace*{0.27 in} parm[Data$pos.rho] <- rho <- interval(parm[Data$pos.rho], -1, 1) \\
\hspace*{0.27 in} epsilon.mu <- rho * rowSums(epsilon * Data$A) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} epsilon.prior <- sum(dnorm(epsilon, epsilon.mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} rho.prior <- dunif(rho, -1, 1, log=TRUE) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} lambda <- exp(log(Data$E) + beta[1] + beta[2]*Data$x/10 + epsilon) \\
\hspace*{0.27 in} LL <- sum(dpois(Data$y, lambda, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + epsilon.prior + rho.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rpois(length(lambda), lambda), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,2), rep(0,N), 0, 1)}

\section{Conditional Predictive Ordinate} \label{cpo}
For a more complete introduction to the conditional predictive ordinate (CPO), see the vignette entitled ``Bayesian Inference''. Following is a brief guide to the applied use of CPO.

To include CPO in any model that is to be updated with MCMC, calculate and monitor the record-level inverse of the likelihood, $\mathrm{InvL}_i$ for records $i=1,\dots,N$. $\mathrm{CPO}_i$ is the inverse of the posterior mean of $\mathrm{InvL}_i$. The inverse $\mathrm{CPO}_i$, or $\mathrm{ICPO}_i$, is the posterior mean of $\mathrm{InvL}_i$. ICPOs larger than 40 can be considered as possible outliers, and higher than 70 as extreme values.

Here, CPO is added to the linear regression example in section \ref{linear.reg}. In this data, record 6 is a possible outlier, and record 8 is an extreme value.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu = \textbf{X}\beta$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonsnacks) \\
y <- log(demonsnacks$Calories) \\
X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\
J <- ncol(X) \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
mon.names <- c("LP",as.parm.names(list(InvL=rep(0,N)))) \\
parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(beta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} LL <- dnorm(Data$y, mu, sigma, log=TRUE) \\
\hspace*{0.27 in} InvL <- 1 / exp(LL) \\
\hspace*{0.27 in} LL <- sum(LL) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,InvL), \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 1)}

\section{Contingency Table} \label{contingency.table}
The two-way contingency table, matrix $\textbf{Y}$, can easily be extended to more dimensions. Contingency table $\textbf{Y}$ has J rows and K columns. The cell counts are fit with Poisson regression, according to intercept $\alpha$, main effects $\beta_j$ for each row, main effects $\gamma_k$ for each column, and interaction effects $\delta_{j,k}$ for dependence effects. An omnibus (all cells) test of independence is done by estimating two models (one with $\delta$, and one without), and a large enough Bayes Factor indicates a violation of independence when the model with $\delta$ fits better than the model without $\delta$. In an ANOVA-like style, main effects contrasts can be used to distinguish rows or groups of rows from each other, as well as with columns. Likewise, interaction effects contrasts can be used to test independence in groups of $\delta_{j,k}$ elements. Finally, single-cell interactions can be used to indicate violations of independence for a given cell, such as when zero is not within its 95\% probability interval.
\subsection{Form}
$$\textbf{Y}_{j,k} \sim \mathcal{P}(\lambda_{j,k}), \quad j=1,\dots,J, \quad k=1,\dots,K$$
$$\lambda_{j,k} = \exp(\alpha + \beta_j + \gamma_k + \delta_{j,k}), \quad j=1,\dots,J, \quad k=1,\dots,K$$
$$\alpha \sim \mathcal{N}(0, 1000)$$
$$\beta_j \sim \mathcal{N}(0, \beta^2_\sigma), \quad j=1,\dots,J$$
$$\beta_J = - \displaystyle\sum^{J-1}_{j=1} \beta_j$$
$$\beta_\sigma \sim \mathcal{HC}(25)$$
$$\gamma_k \sim \mathcal{N}(0, \gamma^2_\sigma), \quad k=1,\dots,K$$
$$\gamma_K = - \displaystyle\sum^{K-1}_{k=1} \gamma_k$$
$$\gamma_\sigma \sim \mathcal{HC}(25)$$
$$\delta_{j,k} \sim \mathcal{N}(0, \delta^2_\sigma)$$
$$\delta_{J,K} = - \displaystyle\sum \delta_{-J,-K}$$
$$\delta_\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{J <- 4 \#Rows \\
K <- 4 \#Columns \\
Y <- matrix(c(20,94,84,17,68,7,119,26,5,16,29,14,15,10,54,14), 4, 4) \\
rownames(Y) <- c("Black", "Blond", "Brunette", "Red") \\
colnames(Y) <- c("Blue", "Brown", "Green", "Hazel") \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=0, beta=rep(0,J-1), \\
\hspace*{0.27 in} gamma=rep(0,K-1), delta=rep(0,J*K-1), b.sigma=0, g.sigma=0, \\
\hspace*{0.27 in} d.sigma=0)) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
pos.delta <- grep("delta", parm.names) \\
pos.b.sigma <- grep("b.sigma", parm.names) \\
pos.g.sigma <- grep("g.sigma", parm.names) \\
pos.d.sigma <- grep("d.sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(1,log(mean(Y)),1) \\
\hspace*{0.27 in} beta <- rnorm(Data$J-1) \\
\hspace*{0.27 in} gamma <- rnorm(Data$K-1) \\
\hspace*{0.27 in} delta <- rnorm(Data$J*Data$K-1) \\
\hspace*{0.27 in} sigma <- runif(3) \\
\hspace*{0.27 in} return(c(alpha, beta, gamma, delta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, K=K, PGF=PGF, Y=Y, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\
\hspace*{0.27 in} pos.gamma=pos.gamma, pos.delta=pos.delta, pos.b.sigma=pos.b.sigma, \\
\hspace*{0.27 in} pos.g.sigma=pos.g.sigma, pos.d.sigma=pos.d.sigma) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Hyperparameters \\
\hspace*{0.27 in} beta.sigma <- interval(parm[Data$pos.b.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.b.sigma] <- beta.sigma \\
\hspace*{0.27 in} gamma.sigma <- interval(parm[Data$pos.g.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.g.sigma] <- gamma.sigma \\
\hspace*{0.27 in} delta.sigma <- interval(parm[Data$pos.d.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.d.sigma] <- delta.sigma \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} beta <- c(beta, -sum(beta)) \\
\hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\
\hspace*{0.27 in} gamma <- c(gamma, -sum(gamma)) \\
\hspace*{0.27 in} delta <- parm[Data$pos.delta] \\
\hspace*{0.27 in} delta <- c(delta, -sum(delta)) \\
\hspace*{0.27 in} delta <- matrix(delta, Data$J, Data$K) \\
\hspace*{0.27 in} \#\#\# Log-Hyperprior \\
\hspace*{0.27 in} beta.sigma.prior <- dhalfcauchy(beta.sigma, 25, log=TRUE) \\
\hspace*{0.27 in} gamma.sigma.prior <- dhalfcauchy(gamma.sigma, 25, log=TRUE) \\
\hspace*{0.27 in} delta.sigma.prior <- dhalfcauchy(delta.sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, beta.sigma, log=TRUE)) \\
\hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, gamma.sigma, log=TRUE)) \\
\hspace*{0.27 in} delta.prior <- sum(dnorm(delta, 0, delta.sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} beta <- matrix(beta, Data$J, Data$K) \\
\hspace*{0.27 in} gamma <- matrix(gamma, Data$J, Data$K, byrow=TRUE) \\
\hspace*{0.27 in} lambda <- exp(alpha + beta + gamma + delta) \\
\hspace*{0.27 in} LL <- sum(dpois(Data$Y, lambda, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + beta.sigma.prior + \\
\hspace*{0.62 in} gamma.prior + gamma.sigma.prior + delta.prior + \\
\hspace*{0.62 in} delta.sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rpois(length(lambda), lambda), \\
\hspace*{0.62 in} parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(log(mean(Y)), rep(0,J-1), rep(0,K-1), rep(0,J*K-1), \\
\hspace*{0.27 in} rep(1,3)) \\}

\section{Discrete Choice, Conditional Logit} \label{conditional.logit}
\subsection{Form}
$$\textbf{y}_i \sim \mathcal{CAT}(\textbf{p}_{i,1:J}), \quad i=1,\dots,N, \quad j=1,\dots,J$$
$$\textbf{p}_{i,j} = \frac{\phi_{i,j}}{\sum^J_{j=1} \phi_{i,j}}$$
$$\phi = \exp(\mu)$$
$$\mu_{i,j} = \beta_{j,1:K} \textbf{X}_{i,1:K} + \gamma \textbf{Z}_{i,1:C} \in [-700,700], \quad j=1,\dots,(J-1)$$
$$\mu_{i,J} = \gamma \textbf{Z}_{i,1:C}$$
$$\beta_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1)$$
$$\gamma_c \sim \mathcal{N}(0, 1000)$$
\subsection{Data}
\code{data(demonchoice) \\
y <- as.numeric(demonchoice[,1]) \\
X <- cbind(1, as.matrix(demonchoice[,2:3])) \\
Z <- as.matrix(demonchoice[,4:9]) \\
for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\
for (j in 1:ncol(Z)) Z[,j] <- CenterScale(Z[,j]) \\
N <- length(y) \#Number of records \\
J <- length(unique(y)) \#Number of categories in y \\
K <- ncol(X) \#Number of individual attributes (including the intercept) \\
C <- ncol(Z) \#Number of choice-based attributes (intercept is not included) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=matrix(0,J-1,K), gamma=rep(0,C))) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm((Data$J-1)*Data$K) \\
\hspace*{0.27 in} gamma <- rnorm(Data$C) \\
\hspace*{0.27 in} return(c(beta, gamma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(C=C, J=J, K=K, N=N, PGF=PGF, X=X, Z=Z, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J-1, Data$K) \\
\hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- matrix(tcrossprod(gamma, Data$Z), Data$N, Data$J) \\
\hspace*{0.27 in} mu[,-Data$J] <- mu[,-Data$J] + tcrossprod(Data$X, beta) \\
\hspace*{0.27 in} mu <- interval(mu, -700, 700, reflect=FALSE) \\
\hspace*{0.27 in} phi <- exp(mu) \\
\hspace*{0.27 in} p <- phi / rowSums(phi) \\
\hspace*{0.27 in} LL <- sum(dcat(Data$y, p, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(p), p), \\
\hspace*{0.62 in} parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,(J-1)*K), rep(0,C))}

\section{Discrete Choice, Mixed Logit} \label{dc.mixed.logit}
\subsection{Form}
$$\textbf{y}_i \sim \mathcal{CAT}(\textbf{p}_{i,1:J}), \quad i=1,\dots,N$$
$$\textbf{p}_{i,j} = \frac{\phi_{i,j}}{\sum^J_{j=1} \phi_{i,j}}$$
$$\phi = \exp(\mu)$$
$$\mu_{i,j} = \beta_{j,1:K,i} \textbf{X}_{i,1:K} + \gamma \textbf{Z}_{i,1:C} \in [-700,700], \quad i=1,\dots,N, \quad j=1,\dots,(J-1)$$
$$\mu_{i,J} = \gamma \textbf{Z}_{i,1:C}$$
$$\beta_{j,k,i} \sim \mathcal{N}(\zeta^\mu_{j,k}, \zeta^\sigma2_{j,k}), \quad i=1,\dots,N, \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$
$$\gamma_c \sim \mathcal{N}(0, 1000), \quad c=1,\dots,C$$
$$\zeta^\mu_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$
$$\zeta^\sigma_{j,k} \sim \mathcal{HC}{25}), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$
\subsection{Data}
\code{data(demonchoice) \\
y <- as.numeric(demonchoice[,1]) \\
X <- cbind(1, as.matrix(demonchoice[,2:3])) \\
Z <- as.matrix(demonchoice[,4:9]) \\
for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\
for (j in 1:ncol(Z)) Z[,j] <- CenterScale(Z[,j]) \\
N <- length(y) \\
J <- length(unique(y)) \#Number of categories in y \\
K <- ncol(X) \#Number of predictors (including the intercept) \\
C <- ncol(Z) \#Number of choice-based attributes (intercept is not included) \\
S <- diag(J-1) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=array(0, dim=c(J-1,K,N)), \\
\hspace*{0.27 in} gamma=rep(0,C), zeta.mu=matrix(0,J-1,K), zeta.sigma=matrix(0,J-1,K))) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
pos.zeta.mu <- grep("zeta.mu", parm.names) \\
pos.zeta.sigma <- grep("zeta.sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} zeta.mu <- matrix(rnorm((Data$J-1)*Data$K), Data$J-1, Data$K) \\
\hspace*{0.27 in} zeta.sigma <- matrix(runif((Data$J-1)*Data$K), Data$J-1, Data$K) \\
\hspace*{0.27 in} beta <- array(rnorm((Data$J-1)*Data$K*Data$N), \\
\hspace*{0.62 in} dim=c( Data$J-1, Data$K, Data$N)) \\
\hspace*{0.27 in} gamma <- rnorm(Data$C) \\
\hspace*{0.27 in} return(c(beta, gamma, as.vector(zeta.mu), as.vector(zeta.sigma))) \\
\hspace*{0.27 in} \} \\
MyData <- list(C=C, J=J, K=K, N=N, PGF=PGF, S=S, X=X, Z=Z, \\
\hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, \\
\hspace*{0.27 in} pos.gamma=pos.gamma, pos.zeta.mu=pos.zeta.mu, \\
\hspace*{0.27 in} pos.zeta.sigma=pos.zeta.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- array(parm[Data$pos.beta], dim=c(Data$J-1, Data$K, Data$N)) \\
\hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\
\hspace*{0.27 in} zeta.mu <- matrix(parm[Data$pos.zeta.mu], Data$J-1, Data$K) \\
\hspace*{0.27 in} zeta.sigma <- matrix(interval(parm[Data$pos.zeta.sigma], 1e-100, Inf), \\
\hspace*{0.62 in} Data$J-1, Data$K) \\
\hspace*{0.27 in} parm[Data$pos.zeta.sigma] <- as.vector(zeta.sigma) \\
\hspace*{0.27 in} \#\#\# Log-Hyperprior \\
\hspace*{0.27 in} zeta.mu.prior <- sum(dnormv(zeta.mu, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} zeta.sigma.prior <- sum(dhalfcauchy(zeta.sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnorm(beta, zeta.mu, zeta.sigma, log=TRUE)) \\
\hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- matrix(tcrossprod(Data$Z, t(gamma)), Data$N, Data$J) \\
\hspace*{0.27 in} for (j in 1:(Data$J-1)) mu[,j] <- rowSums(Data$X * t(beta[j, , ])) \\
\hspace*{0.27 in} mu <- interval(mu, -700, 700, reflect=FALSE) \\
\hspace*{0.27 in} phi <- exp(mu) \\
\hspace*{0.27 in} p <- phi / rowSums(phi) \\
\hspace*{0.27 in} LL <- sum(dcat(Data$y, p, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + zeta.mu.prior + zeta.sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(p), p), \\
\hspace*{0.62 in} parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,(J-1)*K*N), rep(0,C), rep(0,(J-1)*K), \\
\hspace*{0.27 in} rep(1,(J-1)*K))}

\section{Discrete Choice, Multinomial Probit} \label{dc.mnp}
\subsection{Form}
$$\textbf{W}_{i,1:(J-1)} \sim \mathcal{N}_{J-1}(\mu_{i,1:(J-1)}, \Sigma), \quad i=1,\dots,N$$
\[\textbf{W}_{i,j} \in \left\{
\begin{array}{l l}
 $[0,10]$ & \quad \mbox{if $\textbf{y}_i = j$}\\
 $[-10,0]$ \\ \end{array} \right. \]
$$\mu_{1:N,j} = \textbf{X} \beta_{j,1:K} + \textbf{Z} \gamma$$
$$\Sigma = \textbf{U}^T \textbf{U}$$
$$\beta_{j,k} \sim \mathcal{N}(0, 10), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$
$$\gamma_c \sim \mathcal{N}(0, 10), \quad c=1,\dots,C$$
$$\textbf{U}_{j,k} \sim \mathcal{N}(0,1), \quad j=1,\dots,(J-1), \quad k=1,\dots,(J-1), \quad j \ge k, \quad j \ne k = 1$$
\subsection{Data}
\code{data(demonchoice) \\
y <- as.numeric(demonchoice[,1]) \\
X <- cbind(1, as.matrix(demonchoice[,2:3])) \\
Z <- as.matrix(demonchoice[,4:9]) \\
for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\
for (j in 1:ncol(Z)) Z[,j] <- CenterScale(Z[,j]) \\
J <- length(unique(y)) \#Number of categories in y \\
K <- ncol(X) \#Number of predictors (including the intercept) \\
C <- ncol(Z) \#Number of choice-based attributes (intercept is not included) \\
S <- diag(J-1) \\
U <- matrix(NA,J-1,J-1) \\
U[upper.tri(U, diag=TRUE)] <- 0 \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=matrix(0,(J-1),K), gamma=rep(0,C), \\
\hspace*{0.27 in} U=U, W=matrix(0,N,J-1))) \\
parm.names <- parm.names[-which(parm.names == "U[1,1]")] \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
pos.U <- grep("U", parm.names) \\
pos.W <- grep("W", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm((Data$J-1)*Data$K) \\
\hspace*{0.27 in} gamma <- rnorm(Data$C) \\
\hspace*{0.27 in} U <- rnorm((Data$J-2) + (factorial(Data$J-1) / \\
\hspace*{0.62 in} (factorial(Data$J-1-2)*factorial(2))),0,1) \\
\hspace*{0.27 in} W <- matrix(runif(Data$N*(Data$J-1),-10,0), Data$N, Data$J-1) \\
\hspace*{0.27 in} Y <- as.indicator.matrix(Data$y) \\
\hspace*{0.27 in} W <- ifelse(Y[,-Data$J] == 1, abs(W), W) \\
\hspace*{0.27 in} return(c(beta, gamma, U, as.vector(W)))\} \\
MyData <- list(C=C, J=J, K=K, N=N, PGF=PGF, S=S, X=X, Z=Z, \\
\hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, \\
\hspace*{0.27 in} pos.gamma=pos.gamma, pos.U=pos.U, pos.W=pos.W, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J-1, Data$K) \\
\hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\
\hspace*{0.27 in} u <- c(0, parm[Data$pos.U]) \\
\hspace*{0.27 in} U <- diag(Data$J-1) \\
\hspace*{0.27 in} U[upper.tri(U, diag=TRUE)] <- u \\
\hspace*{0.27 in} diag(U) <- exp(diag(U)) \\
\hspace*{0.27 in} Sigma <- t(U) \%*\% U \\
\hspace*{0.27 in} Sigma[1,] <- Sigma[,1] <- U[1,] \\
\hspace*{0.27 in} W <- matrix(parm[Data$pos.W], Data$N, Data$J-1) \\
\hspace*{0.27 in} Y <- as.indicator.matrix(Data$y) \\
\hspace*{0.27 in} temp <- which(Y[,-c(Data$J)] == 1) \\
\hspace*{0.27 in} W[temp] <- interval(W[temp], 0, 10) \\
\hspace*{0.27 in} temp <- which(Y[,-c(Data$J)] == 0) \\
\hspace*{0.27 in} W[temp] <- interval(W[temp], -10, 0) \\
\hspace*{0.27 in} parm[Data$pos.W] <- as.vector(W) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 10, log=TRUE)) \\
\hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 10, log=TRUE)) \\
\hspace*{0.27 in} U.prior <- sum(dnorm(u[-1], 0, 1, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) + \\
\hspace*{0.62 in} as.vector(tcrossprod(Data$Z, t(gamma))) \\
\hspace*{0.27 in} \#eta <- exp(cbind(mu,0)) \\
\hspace*{0.27 in} \#p <- eta / rowSums(eta) \\
\hspace*{0.27 in} LL <- sum(dmvn(W, mu, Sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + U.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=max.col(cbind(rmvn(nrow(mu), mu, Sigma),0)), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- GIV(Model, MyData, PGF=TRUE)}

\section{Distributed Lag, Koyck} \label{dl.koyck}
This example applies Koyck or geometric distributed lags to $k=1,\dots,K$ discrete events in covariate $\textbf{x}$, transforming the covariate into a $N$ x $K$ matrix $\textbf{X}$ and creates a $N$ x $K$ lag matrix $\textbf{L}$.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu_t = \alpha + \phi \textbf{y}_{t-1} + \sum^K_{k=1} \textbf{X}_{t,k} \beta \lambda^{\textbf{L}[t,k]}, \quad k=1,\dots,K, \quad t=2,\dots,T$$
$$\mu_1 = \alpha + \sum^K_{k=1} \textbf{X}_{1,k} \beta \lambda^{\textbf{L}[1,k]}, \quad k=1,\dots,K$$
$$\alpha \sim \mathcal{N}(0, 1000)$$
$$\beta \sim \mathcal{N}(0, 1000)$$
$$\lambda \sim \mathcal{U}(0, 1)$$
$$\phi \sim \mathcal{N}(0, 1000)$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonfx) \\
y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\
x <- (y > 0.01)*1 \#Made-up distributed lag IV \\
T <- length(y) \\
K <- length(which(x != 0)) \\
L <- X <- matrix(0, T, K) \\
for (i in 1:K) \{ \\
\hspace*{0.27 in} X[which(x != 0)[i]:T,i] <- x[which(x != 0)[i]] \\
\hspace*{0.27 in} L[(which(x != 0)[i]):T,i] <- 0:(T - which(x != 0)[i])\} \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=0, beta=0, lambda=0, phi=0, sigma=0)) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(1) \\
\hspace*{0.27 in} beta <- rnorm(1) \\
\hspace*{0.27 in} lambda <- runif(1) \\
\hspace*{0.27 in} phi <- rnorm(1) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(alpha, beta, lambda, phi, sigma)) \\
\hspace*{0.27 in} \} \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.lambda <- grep("lambda", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
MyData <- list(L=L, PGF=PGF, T=T, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\
\hspace*{0.27 in} pos.lambda=pos.lambda, pos.phi=pos.phi, pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} lambda <- interval(parm[Data$pos.lambda], 0, 1) \\
\hspace*{0.27 in} parm[Data$pos.lambda] <- lambda \\
\hspace*{0.27 in} phi <- parm[Data$pos.phi] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} beta.prior <- dnormv(beta, 0, 1000, log=TRUE) \\ 
\hspace*{0.27 in} lambda.prior <- dunif(lambda, 0, 1, log=TRUE) \\
\hspace*{0.27 in} phi.prior <- dnormv(phi, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- c(alpha, alpha + phi*Data$y[-Data$T]) + \\
\hspace*{0.62 in} rowSums(Data$X * beta * lambda\textasciicircum Data$L) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y[-1], mu[-1], sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + lambda.prior + phi.prior + \\
\hspace*{0.62 in} sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,2), 0.5, 0, 1)}

\section{Dynamic Sparse Factor Model (DSFM)} \label{dsfm}
\subsection{Form}
$$\textbf{Y}_{t,j} \sim \mathcal{N}(\alpha{t,j} + \textbf{F}_{t,1:P} \Lambda_{1:P,1:j,t}, \Sigma^2_{t,j}), \quad t=1,\dots,T, \quad j=1,\dots,J$$
$$\alpha_{t,j} \sim \mathcal{N}(\alpha^\mu_j + \alpha^\phi_j(\alpha_{t-1,j} - \alpha^mu_j), \alpha^\sigma2_j)$$
$$\textbf{F}_{t,1:P} \sim \mathcal{N}_P(\textbf{F}^\phi \textbf{F}_{t-1,1:P}, \textbf{f}^\Sigma_{t,1:P})$$
$$\textbf{f}^\Sigma_{t,1:P} = t(\textbf{f}^\textbf{U}_{1:P,1:P,t})\textbf{f}^\textbf{U}_{1:P,1:P,t}$$
$$\textbf{f}^\textbf{U}_{p,q,t} \sim \mathcal{N}(\textbf{f}^{\textbf{u}_\mu}_{p,q} + \textbf{f}^{\textbf{u}_\phi}_{p,q}(\textbf{f}^\textbf{U}_{p,q,t-1} - \textbf{f}^{\textbf{u}_\mu}_{p,q}), \textbf{f}^{\textbf{u}_\sigma^2}_{p,q})$$
$$\Lambda_{p,j,t} \sim \mathcal{N}(\lambda^\mu_{p,j} + \lambda^\phi_{p,j}(\Lambda_{p,j,t-1} - \lambda^mu_{p,j}), \lambda^\sigma2_{p,j})$$
$$\Sigma_{t,j} = \exp(\log(\Sigma_{t,j}))$$
$$log(\Sigma_{t,j}) \sim \mathcal{N}(\sigma^\mu_j + \sigma^\phi_j(log(\Sigma_{t-1,j}) - \sigma^mu_j), \sigma^\sigma2_j)$$
$$\alpha^0_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$
$$\alpha^\mu_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$
$$\frac{\alpha^\phi_j+1}{2} \sim \mathcal{BETA}(20, 1.5), \quad j=1,\dots,J$$
$$\alpha^\sigma_j \sim \mathcal{HC}(5), \quad j=1,\dots,J$$
$$\textbf{f}^0_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$
$$\frac{\textbf{f}^\phi_j+1}{2} \sim \mathcal{BETA}(1, 1), \quad j=1,\dots,J$$
$$\textbf{f}^{\textbf{u}0}_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$
$$\textbf{f}^{\textbf{u}\mu}_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$
$$\frac{\textbf{f}^{\textbf{u}\phi}_j+1}{2} \sim \mathcal{BETA}(20, 1.5), \quad j=1,\dots,J$$
$$\textbf{f}^{\textbf{u}\sigma}_j \sim \mathcal{HC}(1), \quad j=1,\dots,J$$
$$\lambda^0_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$
$$\lambda^d_j \sim \mathcal{U}(0, |\lambda^\mu_j| + 3\sqrt{\frac{\lambda^\sigma_j}{1 - \lambda^\phi_j\lambda^\phi_j}}), \quad j=1,\dots,J$$
$$\lambda^\mu_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$
$$\frac{\lambda^\phi_j+1}{2} \sim \mathcal{BETA}(20, 1.5), \quad j=1,\dots,J$$
$$\lambda^\sigma_j \sim \mathcal{HC}(1), \quad j=1,\dots,J$$
$$\log(\sigma^0_j) \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$
$$\log(\sigma^\mu_j) \sim \mathcal{N}(0, 1), \quad j=1,\dots,J$$
$$\frac{\log(\sigma^\phi_j)+1}{2} \sim \mathcal{BETA}(20, 1.5), \quad j=1,\dots,J$$
$$\log(\sigma^\sigma_j) \sim \mathcal{HC}(1), \quad j=1,\dots,J$$
\subsection{Data}
\code{data(demonfx) \\
Y.orig <- demonfx \\
Y <- log(as.matrix(Y.orig[1:20,1:3])) \\
Y.means <- colMeans(Y) \\
Y <- Y - matrix(Y.means, nrow(Y), ncol(Y), byrow=TRUE) \#Center \\
Y.scales <- sqrt(.colVars(Y)) \\
Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \#Scale \\
T <- nrow(Y) \#Number of time-periods \\
J <- ncol(Y) \#Number of time-series \\
P <- 2 \#Number of dynamic factors \\
mon.names <- "LP" \\
U1 <- matrix(NA,P,P); U2 <- matrix(NA,P,J) \\
U1[upper.tri(U1, diag=TRUE)] <- 0; U2[upper.tri(U2)] <- 0 \\
Lambda <- array(NA, dim=c(P,J,T)) \\
U <- array(NA, dim=c(P,P,T)) \\
for (t in 1:T) \{ \\
\hspace*{0.27 in} U[ , , t] <- U1 \\
\hspace*{0.27 in} Lambda[ , , t] <- U2\} \\
parm.names <- as.parm.names(list(alpha0=rep(0,J), Alpha=matrix(0,T,J), \\
\hspace*{0.27 in} alpha.mu=rep(0,J), alpha.phi=rep(0,J), alpha.sigma=rep(0,J), \\
\hspace*{0.27 in} f0=rep(0,P), F=matrix(0,T,P), f.phi=rep(0,P), f.u0=U1, f.U=U, \\
\hspace*{0.27 in} f.u.mu=U1, f.u.phi=U1, f.u.sigma=U1, lambda0=U2, Lambda=Lambda, \\
\hspace*{0.27 in} lambda.d=U2, lambda.mu=U2, lambda.phi=U2, lambda.sigma=U2, \\
\hspace*{0.27 in} lsigma0=rep(0,J), lSigma=matrix(0,T,J), \\
\hspace*{0.27 in} lsigma.mu=rep(0,J), lsigma.phi=rep(0,J), lsigma.sigma=rep(0,J))) \\
pos.alpha0 <- grep("alpha0", parm.names) \\
pos.Alpha <- grep("Alpha", parm.names) \\
pos.alpha.mu <- grep("alpha.mu", parm.names) \\
pos.alpha.phi <- grep("alpha.phi", parm.names) \\
pos.alpha.sigma <- grep("alpha.sigma", parm.names) \\
pos.f0 <- grep("f0", parm.names) \\
pos.F <- grep("F", parm.names) \\
pos.f.phi <- grep("f.phi", parm.names) \\
pos.f.u0 <- grep("f.u0", parm.names) \\
pos.f.U <- grep("f.U", parm.names) \\
pos.f.u.mu <- grep("f.u.mu", parm.names) \\
pos.f.u.phi <- grep("f.u.phi", parm.names) \\
pos.f.u.sigma <- grep("f.u.sigma", parm.names) \\
pos.lambda0 <- grep("lambda0", parm.names) \\
pos.Lambda <- grep("Lambda", parm.names) \\
pos.lambda.d <- grep("lambda.d", parm.names) \\
pos.lambda.mu <- grep("lambda.mu", parm.names) \\
pos.lambda.phi <- grep("lambda.phi", parm.names) \\
pos.lambda.sigma <- grep("lambda.sigma", parm.names) \\
pos.lsigma0 <- grep("lsigma0", parm.names) \\
pos.lSigma <- grep("lSigma", parm.names) \\
pos.lsigma.mu <- grep("lsigma.mu", parm.names) \\
pos.lsigma.phi <- grep("lsigma.phi", parm.names) \\
pos.lsigma.sigma <- grep("lsigma.sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha0 <- rnorm(Data$J) \\
\hspace*{0.27 in} Alpha <- rnorm(Data$T*Data$J) \\
\hspace*{0.27 in} alpha.mu <- rnorm(Data$J) \\
\hspace*{0.27 in} alpha.phi <- rbeta(Data$J, 20, 1.5) * 2 - 1 \\
\hspace*{0.27 in} alpha.sigma <- runif(Data$J) \\
\hspace*{0.27 in} f0 <- rnorm(Data$P) \\
\hspace*{0.27 in} F <- rnorm(Data$T*Data$P) \\
\hspace*{0.27 in} f.phi <- rbeta(Data$P, 1, 1) * 2 - 1 \\
\hspace*{0.27 in} f.u0 <- rnorm(length(Data$pos.f.u0)) \\
\hspace*{0.27 in} f.U <- rnorm(length(Data$pos.f.U)) \\
\hspace*{0.27 in} f.u.mu <- rnorm(length(Data$pos.f.u.mu)) \\
\hspace*{0.27 in} f.u.phi <- runif(length(Data$pos.f.u.phi)) \\
\hspace*{0.27 in} f.u.sigma <- runif(length(Data$pos.f.u.sigma)) \\
\hspace*{0.27 in} lambda0 <- rnorm(length(Data$pos.lambda0)) \\
\hspace*{0.27 in} Lambda <- rnorm(length(Data$pos.Lambda)) \\
\hspace*{0.27 in} lambda.mu <- rnorm(length(Data$pos.lambda.mu)) \\
\hspace*{0.27 in} lambda.phi <- rbeta(length(Data$pos.lambda.phi), 20, 1.5) \\
\hspace*{0.27 in} lambda.sigma <- runif(length(Data$pos.lambda.sigma)) \\
\hspace*{0.27 in} lambda.d <- runif(length(Data$pos.lambda.d), 0, abs(lambda.mu) + \\
\hspace*{0.62 in} 3*sqrt(lambda.sigma/(1-lambda.phi\textasciicircum 2))) \\
\hspace*{0.27 in} lsigma0 <- rnorm(Data$J) \\
\hspace*{0.27 in} lSigma <- rnorm(Data$T*Data$J) \\
\hspace*{0.27 in} lsigma.mu <- rnorm(Data$J) \\
\hspace*{0.27 in} lsigma.phi <- rbeta(Data$J, 20, 1.5) * 2 - 1 \\
\hspace*{0.27 in} lsigma.sigma <- runif(Data$J) \\
\hspace*{0.27 in} return(c(alpha0, Alpha, alpha.mu, alpha.phi, alpha.sigma, f0, F, \\
\hspace*{0.62 in} f.phi, f.u0, f.U, f.u.mu, f.u.phi, f.u.sigma, lambda0, Lambda, \\
\hspace*{0.62 in} lambda.d, lambda.mu, lambda.phi, lambda.sigma, lsigma0, lSigma, \\
\hspace*{0.62 in} lsigma.mu, lsigma.phi, lsigma.sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, P=P, PGF=PGF, T=T, Y=Y, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha0=pos.alpha0, pos.Alpha=pos.Alpha, \\
\hspace*{0.27 in} pos.alpha.mu=pos.alpha.mu, pos.alpha.phi=pos.alpha.phi, \\
\hspace*{0.27 in} pos.alpha.sigma=pos.alpha.sigma, pos.f0=pos.f0, pos.F=pos.F, \\
\hspace*{0.27 in} pos.f.phi=pos.f.phi, pos.f.u0=pos.f.u0, pos.f.U=pos.f.U, \\
\hspace*{0.27 in} pos.f.u.mu=pos.f.u.mu, pos.f.u.phi=pos.f.u.phi, \\
\hspace*{0.27 in} pos.f.u.sigma=pos.f.u.sigma, pos.lambda0=pos.lambda0, \\
\hspace*{0.27 in} pos.Lambda=pos.Lambda, pos.lambda.d=pos.lambda.d, \\
\hspace*{0.27 in} pos.lambda.mu=pos.lambda.mu, pos.lambda.phi=pos.lambda.phi, \\
\hspace*{0.27 in} pos.lambda.sigma=pos.lambda.sigma, pos.lsigma0=pos.lsigma0, \\
\hspace*{0.27 in} pos.lSigma=pos.lSigma, pos.lsigma.mu=pos.lsigma.mu, \\
\hspace*{0.27 in} pos.lsigma.phi=pos.lsigma.phi, pos.lsigma.sigma=pos.lsigma.sigma) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha0 <- parm[Data$pos.alpha0] \\
\hspace*{0.27 in} Alpha <- matrix(parm[Data$pos.Alpha], Data$T, Data$J)\\
\hspace*{0.27 in} alpha.mu <- parm[Data$pos.alpha.mu] \\
\hspace*{0.27 in} alpha.phi <- interval(parm[Data$pos.alpha.phi], -1, 1) \\
\hspace*{0.27 in} parm[Data$pos.alpha.phi] <- alpha.phi \\
\hspace*{0.27 in} alpha.sigma <- interval(parm[Data$pos.alpha.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.alpha.sigma] <- alpha.sigma \\
\hspace*{0.27 in} f0 <- parm[Data$pos.f0] \\
\hspace*{0.27 in} F <- matrix(parm[Data$pos.F], Data$T, Data$P) \\
\hspace*{0.27 in} f.phi <- interval(parm[Data$pos.f.phi], -1, 1) \\
\hspace*{0.27 in} parm[Data$pos.f.phi] <- f.phi \\
\hspace*{0.27 in} f.u0 <- parm[Data$pos.f.u0] \\
\hspace*{0.27 in} f.U <- parm[Data$pos.f.U] \\
\hspace*{0.27 in} f.u.mu <- parm[Data$pos.f.u.mu] \\
\hspace*{0.27 in} f.u.phi <- interval(parm[Data$pos.f.u.phi], -1, 1) \\
\hspace*{0.27 in} parm[Data$pos.f.u.phi] <- f.u.phi \\
\hspace*{0.27 in} f.u.sigma <- interval(parm[Data$pos.f.u.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.f.u.sigma] <- f.u.sigma \\
\hspace*{0.27 in} lambda0 <- parm[Data$pos.lambda0] \\
\hspace*{0.27 in} Lambda <- parm[Data$pos.Lambda] \\
\hspace*{0.27 in} lambda.mu <- parm[Data$pos.lambda.mu] \\
\hspace*{0.27 in} lambda.phi <- interval(parm[Data$pos.lambda.phi], -1, 1) \\
\hspace*{0.27 in} parm[Data$pos.lambda.phi] <- lambda.phi \\
\hspace*{0.27 in} lambda.sigma <- interval(parm[Data$pos.lambda.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.lambda.sigma] <- lambda.sigma \\
\hspace*{0.27 in} lambda.d <- parm[Data$pos.lambda.d] \\
\hspace*{0.27 in} for (i in 1:length(lambda.d)) \\
\hspace*{0.62 in} lambda.d[i] <- interval(lambda.d[i], 0, abs(lambda.mu[i]) + \\
\hspace*{0.62 in} 3*sqrt(lambda.sigma[i]/(1-lambda.phi[i]\textasciicircum 2))) \\
\hspace*{0.27 in} parm[Data$pos.lambda.d] <- lambda.d \\
\hspace*{0.27 in} lsigma0 <- parm[Data$pos.lsigma0] \\
\hspace*{0.27 in} lSigma <- matrix(parm[Data$pos.lSigma], Data$T, Data$J) \\
\hspace*{0.27 in} lsigma.mu <- parm[Data$pos.lsigma.mu] \\
\hspace*{0.27 in} lsigma.phi <- interval(parm[Data$pos.lsigma.phi], -1, 1) \\
\hspace*{0.27 in} parm[Data$pos.lsigma.phi] <- lsigma.phi \\
\hspace*{0.27 in} lsigma.sigma <- interval(parm[Data$pos.lsigma.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.lsigma.sigma] <- lsigma.sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha0.prior <- sum(dnorm(alpha0, 0, 1, log=TRUE)) \\
\hspace*{0.27 in} Alpha.prior <- sum(dnorm(Alpha, \\
\hspace*{0.62 in} matrix(alpha.mu, Data$T, Data$J, byrow=TRUE) + \\
\hspace*{0.62 in} matrix(alpha.phi, Data$T, Data$J, byrow=TRUE) * \\
\hspace*{0.62 in} (rbind(alpha0, Alpha[-Data$T,]) - \\
\hspace*{0.62 in} matrix(alpha.mu, Data$T, Data$J, byrow=TRUE)),\\
\hspace*{0.62 in} matrix(alpha.sigma, Data$T, Data$J, byrow=TRUE), log=TRUE)) \\
\hspace*{0.27 in} alpha.mu.prior <- sum(dnorm(alpha.mu, 0, 1, log=TRUE)) \\
\hspace*{0.27 in} alpha.phi.prior <- sum(dbeta((alpha.phi + 1) / 2, 20, 1.5, log=TRUE)) \\
\hspace*{0.27 in} alpha.sigma.prior <- sum(dhalfcauchy(alpha.sigma, 5, log=TRUE)) \\
\hspace*{0.27 in} f0.prior <- sum(dnorm(f0, 0, 1, log=TRUE)) \\
\hspace*{0.27 in} f.phi.prior <- sum(dbeta((f.phi + 1) / 2, 1, 1, log=TRUE)) \\
\hspace*{0.27 in} f.u0.prior <- sum(dnorm(f.u0, 0, 1, log=TRUE)) \\
\hspace*{0.27 in} f.U.prior <- sum(dnorm(matrix(f.U, nrow=Data$T, byrow=TRUE), \\
\hspace*{0.62 in} matrix(f.u.mu, Data$T, Data$P*(Data$P-1)/2+Data$P, byrow=TRUE) + \\
\hspace*{0.62 in} matrix(f.u.phi, Data$T, Data$P*(Data$P-1)/2+Data$P, byrow=TRUE) * \\
\hspace*{0.62 in} (rbind(f.u0, matrix(f.U, nrow=Data$T, byrow=TRUE)[-Data$T,]) - \\
\hspace*{0.62 in} matrix(f.u.mu, Data$T, Data$P*(Data$P-1)/2+Data$P, byrow=TRUE)), \\
\hspace*{0.62 in} matrix(f.u.sigma, Data$T, Data$P*(Data$P-1)/2+Data$P, byrow=TRUE), \\
\hspace*{0.62 in} log=TRUE)) \\
\hspace*{0.27 in} f.u.mu.prior <- sum(dnorm(f.u.mu, 0, 1, log=TRUE)) \\
\hspace*{0.27 in} f.u.phi.prior <- sum(dbeta((f.u.phi + 1) / 2, 20, 1.5, log=TRUE)) \\
\hspace*{0.27 in} f.u.sigma.prior <- sum(dhalfcauchy(f.u.sigma, 1, log=TRUE)) \\
\hspace*{0.27 in} lambda0.prior <- sum(dnorm(lambda0, 0, 1, log=TRUE)) \\
\hspace*{0.27 in} Lambda.prior <- sum(dnorm(matrix(Lambda, nrow=Data$T, byrow=TRUE), \\
\hspace*{0.62 in} matrix(lambda.mu, Data$T, length(lambda.mu), byrow=TRUE) + \\
\hspace*{0.62 in} (rbind(lambda0, matrix(Lambda, nrow=Data$T, byrow=TRUE))[-(Data$T+1),] - \\
\hspace*{0.62 in} matrix(lambda.mu, Data$T, length(lambda.mu), byrow=TRUE)), \\
\hspace*{0.62 in} matrix(lambda.sigma, Data$T, length(lambda.sigma), byrow=TRUE), \\
\hspace*{0.62 in} log=TRUE)) \\
\hspace*{0.27 in} lambda.d.prior <- sum(dunif(lambda.d, 0, abs(lambda.mu) + \\
\hspace*{0.62 in} 3*sqrt(lambda.sigma/(1-lambda.phi\textasciicircum 2)), log=TRUE)) \\
\hspace*{0.27 in} lambda.mu.prior <- sum(dnorm(lambda.mu, 0, 1, log=TRUE)) \\
\hspace*{0.27 in} lambda.phi.prior <- sum(dbeta((lambda.phi + 1) / 2, 20, 1.5, log=TRUE)) \\
\hspace*{0.27 in} lambda.sigma.prior <- sum(dhalfcauchy(lambda.sigma, 1, log=TRUE)) \\
\hspace*{0.27 in} lsigma0.prior <- sum(dnorm(lsigma0, 0, 1, log=TRUE)) \\
\hspace*{0.27 in} lSigma.prior <- sum(dnorm(lSigma, \\
\hspace*{0.62 in} matrix(lsigma.mu, Data$T, Data$J, byrow=TRUE) + \\
\hspace*{0.62 in} matrix(lsigma.phi, Data$T, Data$J, byrow=TRUE) * \\
\hspace*{0.62 in} (rbind(lsigma0, lSigma[-Data$T,]) - \\
\hspace*{0.62 in} matrix(lsigma.mu, Data$T, Data$J, byrow=TRUE)), \\
\hspace*{0.62 in} matrix(lsigma.sigma, Data$T, Data$J, byrow=TRUE), log=TRUE)) \\
\hspace*{0.27 in} lsigma.mu.prior <- sum(dnorm(lsigma.mu, 0, 1, log=TRUE)) \\
\hspace*{0.27 in} lsigma.phi.prior <- sum(dbeta((lsigma.phi + 1) / 2, 20, 1.5, log=TRUE)) \\
\hspace*{0.27 in} lsigma.sigma.prior <- sum(dhalfcauchy(lsigma.sigma, 1, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} LL <- 0; Yhat <- Data$Y; F.prior <- 0 \\
\hspace*{0.27 in} for (t in 1:Data$T) \{ \\
\hspace*{0.62 in} f.U.temp <- matrix(0, Data$P, Data$P) \\
\hspace*{0.62 in} f.U.temp[upper.tri(f.U.temp, diag=TRUE)] <- matrix(f.U, nrow=Data$T, \\
\hspace*{0.95 in} byrow=TRUE)[t,] \\
\hspace*{0.62 in} diag(f.U.temp) <- exp(diag(f.U.temp)) \\
\hspace*{0.62 in} f.Sigma <- as.symmetric.matrix(t(f.U.temp) \%*\% f.U.temp) \\
\hspace*{0.62 in} F.prior <- F.prior + dmvn(F[t,], rbind(f0, F)[t,] \%*\% diag(f.phi), \\
\hspace*{0.95 in} f.Sigma, log=TRUE) \\
\hspace*{0.62 in} Lambda.temp <- matrix(1, Data$P, Data$J) \\
\hspace*{0.62 in} Lambda.temp[lower.tri(Lambda.temp)] <- 0 \\
\hspace*{0.62 in} Lambda.temp[upper.tri(Lambda.temp)] <- matrix(Lambda, \\
\hspace*{0.95 in} nrow=Data$T, byrow=TRUE)[t,]*(abs(matrix(Lambda, \\
\hspace*{0.95 in} nrow=Data$T, byrow=TRUE)[t,]) > lambda.d) \\
\hspace*{0.62 in} mu <- Alpha[t,] + F[t,] \%*\% Lambda.temp \\
\hspace*{0.62 in} LL <- LL + sum(dnorm(Data$Y[t,], mu, exp(lSigma[t,]), log=TRUE)) \\
\hspace*{0.62 in} Yhat[t,] <- rnorm(Data$J, mu, exp(lSigma[t,])) \#Fitted \\
\hspace*{0.62 in} \} \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha0.prior + Alpha.prior + alpha.mu.prior + \\
\hspace*{0.62 in} alpha.phi.prior + alpha.sigma.prior + f0.prior + F.prior + \\
\hspace*{0.62 in} f.phi.prior + f.u0.prior + f.U.prior + f.u.mu.prior + \\
\hspace*{0.62 in} f.u.phi.prior + f.u.sigma.prior + lambda0.prior + \\
\hspace*{0.62 in} Lambda.prior + lambda.d.prior + lambda.mu.prior + \\
\hspace*{0.62 in} lambda.phi.prior + lambda.sigma.prior + lsigma0.prior + \\
\hspace*{0.62 in} lSigma.prior + lsigma.mu.prior + lsigma.phi.prior + \\
\hspace*{0.62 in} lsigma.sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=Yhat, parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rnorm(J), rnorm(T*J), rnorm(J), runif(J), runif(J), \\
\hspace*{0.27 in} rnorm(P), rnorm(T*P), rbeta(P,1,1)*2-1, rnorm(P*(P-1)/2+P), \\
\hspace*{0.27 in} rnorm((P*(P-1)/2+P)*T), rnorm(P*(P-1)/2+P), \\
\hspace*{0.27 in} rbeta(P*(P-1)/2+P,1,1)*2-1, runif(P*(P-1)/2+P), \\
\hspace*{0.27 in} rnorm(P*J-P-P*(P-1)/2), rnorm((P*J-P-P*(P-1)/2)*T), \\
\hspace*{0.27 in} runif(P*J-P-P*(P-1)/2,0,1e-3), rnorm(P*J-P-P*(P-1)/2), \\
\hspace*{0.27 in} rbeta(P*J-P-P*(P-1)/2,20,1.5)*2-1, runif(P*J-P-P*(P-1)/2), \\
\hspace*{0.27 in} rnorm(J), rnorm(T*J), rnorm(J), rbeta(J,20,1.5)*2-1, runif(J)) \\
}

\section{Exponential Smoothing} \label{exp.smo}
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu_t = \alpha \textbf{y}_{t-1} + (1 - \alpha) \mu_{t-1}, \quad t=2,\dots,T$$
$$\alpha \sim \mathcal{U}(0,1)$$
$$\sigma \sim \mathcal{HC}$$
\subsection{Data}
\code{data(demonfx) \\
y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\
mon.names <- "LP" \\
parm.names <- c("alpha","sigma") \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- runif(1) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(alpha, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(PGF=PGF, T=T, mon.names=mon.names, parm.names=parm.names, \\
\hspace*{0.27 in} y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} parm[1] <- alpha <- interval(parm[1], 0, 1) \\
\hspace*{0.27 in} parm[2] <- sigma <- interval(parm[2], 1e-100, Inf) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dunif(alpha, 0, 1, log=TRUE) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- y \\
\hspace*{0.27 in} mu[-1] <- alpha*Data$y[-1] \\
\hspace*{0.27 in} mu[-1] <- mu[-1] + (1 - alpha) * mu[-Data$T] \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y[-1], mu[-Data$T], sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(0.5, 1)}

\section{Factor Analysis, Approximate Dynamic} \label{adfa}
The Approximate Dynamic Factor Analysis (ADFA) model has many names, including the approximate factor model and approximate dynamic factor model. An ADFA is a Dynamic Factor Analysis (DFA) in which the factor scores of the dynamic factors are approximated with principal components. This is a combination of principal components and common factor analysis, in which the factor loadings of common factors are estimated from the data and factor scores are estimated from principal components. This is a two-stage model: principal components are estimated in the first stage and a decision is made regarding how many principal components to retain, and ADFA is estimated in the second stage. For more information on DFA, see section \ref{dsfm}.
\subsection{Form}
$$\textbf{Y}_{t,j} \sim \mathcal{N}(\mu_{t,j}, \sigma^2_j), \quad t=2,\dots,T, \quad j=1,\dots,J$$
$$\mu_{t,} = \textbf{F}_{t-1,} \Lambda$$
$$\Lambda_{p,j} \sim \mathcal{N}(0, 1), \quad p=1,\dots,P, \quad j=1,\dots,J$$
$$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,J$$
\subsection{Data}
\code{data(demonfx) \\
Y.orig <- as.matrix(demonfx) \\
Y <- diff(log(Y.orig[1:100,])) \\
Y.scales <- sqrt(.colVars(Y)) \\
Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \\
T <- nrow(Y) \#Number of time-periods \\
J <- ncol(Y) \#Number of time-series \\
P <- 7 \#Number of approximate factors \\
PCA <- prcomp(Y, scale=TRUE) \\
F <- PCA$x[,1:P] \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(Lambda=matrix(0,P,J), sigma=rep(0,J))) \\
pos.Lambda <- grep("Lambda", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} Lambda <- rnorm(Data$P*Data$J) \\
\hspace*{0.27 in} sigma <- runif(Data$J) \\
\hspace*{0.27 in} return(c(Lambda, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(F=F, J=J, P=P, PGF=PGF, T=T, Y=Y, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.Lambda=pos.Lambda, pos.sigma=pos.sigma) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} Lambda <- matrix(parm[Data$pos.Lambda], Data$P, Data$J) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} Lambda.prior <- sum(dnorm(Lambda, 0, 1, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(rbind(rep(0,Data$P), F[-Data$T,]), t(Lambda)) \\
\hspace*{0.27 in} Sigma <- matrix(sigma, Data$T, Data$J, byrow=TRUE) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$Y[-1,], mu[-1,], Sigma[-1,], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + Lambda.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,P*J), rep(1,J))}

\section{Factor Analysis, Confirmatory} \label{cfa}
Factor scores are in matrix \textbf{F}, factor loadings for each variable are in vector $\lambda$, and $\textbf{f}$ is a vector that indicates which variable loads on which factor.
\subsection{Form}
$$\textbf{Y}_{i,m} \sim \mathcal{N}(\mu_{i,m}, \sigma^2_m), \quad i=1,\dots,N, \quad m=1,\dots,M$$
$$\mu = \textbf{F}_{1:N,\textbf{f}} \lambda^T$$
$$\textbf{F}_{i,1:P} \sim \mathcal{N}_P(0, \Omega^{-1}), \quad i=1,\dots,N$$
$$\lambda_m \sim \mathcal{N}(0, 1), \quad m=1,\dots,M$$
$$\sigma_m \sim \mathcal{HC}(25), \quad m=1,\dots,M$$
$$\Omega \sim \mathcal{W}_N(\textbf{S}), \quad \textbf{S} = \textbf{I}_P$$ 
\subsection{Data}
\code{data(swiss) \\
Y <- cbind(swiss$Agriculture, swiss$Examination, swiss$Education, \\
\hspace*{0.27 in} swiss$Catholic, swiss$Infant.Mortality) \\
M <- ncol(Y) \#Number of variables \\
N <- nrow(Y) \#Number of records \\
P <- 3 \#Number of factors \\
f <- c(1,3,2,2,1) \#Indicator f for the factor for each variable m \\
for (m in 1:M) Y[,m] <- CenterScale(Y[,m]) \\
S <- diag(P) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(F=matrix(0,N,P), lambda=rep(0,M), \\
\hspace*{0.27 in} U=diag(P), sigma=rep(0,M)), uppertri=c(0,0,1,0)) \\
pos.F <- grep("F", parm.names) \\
pos.lambda <- grep("lambda", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} U <- rwishartc(Data$N, Data$S) \\
\hspace*{0.27 in} F <- as.vector(rmvnpc(Data$N, rep(0,Data$P), U)) \\
\hspace*{0.27 in} U <- U[upper.tri(U, diag=TRUE)] \\
\hspace*{0.27 in} lambda <- rnorm(Data$M) \\
\hspace*{0.27 in} sigma <- runif(Data$M) \\
\hspace*{0.27 in} return(c(F, lambda, U, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(M=M, N=N, P=P, PGF=PGF, S=S, Y=Y, f=f, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.F=pos.F, pos.lambda=pos.lambda, \\
\hspace*{0.27 in} pos.sigma=pos.sigma) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} lambda <- parm[Data$pos.lambda] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} F <- matrix(parm[Data$pos.F], Data$N, Data$P) \\
\hspace*{0.27 in} U <- as.parm.matrix(U, Data$P, parm, Data, chol=TRUE) \\
\hspace*{0.27 in} diag(U) <- exp(diag(U)) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} lambda.prior <- sum(dnorm(lambda, 0, 1, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} U.prior <- dwishartc(U, Data$N, Data$S, log=TRUE) \\
\hspace*{0.27 in} F.prior <- sum(dmvnpc(F, rep(0,Data$P), U, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- F[,Data$f] * matrix(lambda, Data$N, Data$M, byrow=TRUE) \\
\hspace*{0.27 in} Sigma <- matrix(sigma, Data$N, Data$M, byrow=TRUE) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu, Sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + lambda.prior + sigma.prior + F.prior + U.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,N*P), rep(0,M), upper.triangle(S, diag=TRUE), \\
\hspace*{0.27 in} rep(1,M))}

\section{Factor Analysis, Exploratory} \label{efa}
Factor scores are in matrix \textbf{F} and factor loadings are in matrix $\Lambda$.
\subsection{Form}
$$\textbf{Y}_{i,m} \sim \mathcal{N}(\mu_{i,m}, \sigma^2_m), \quad i=1,\dots,N, \quad m=1,\dots,M$$
$$\mu = \textbf{F} \Lambda$$
$$\textbf{F}_{i,1:P} \sim \mathcal{N}_P(0, \Omega^{-1}), \quad i=1,\dots,N$$
$$\Lambda_{p,m} \sim \mathcal{N}(0, 1), \quad p=1,\dots,P, \quad m=(p+1),\dots,M$$
$$\Omega \sim \mathcal{W}_N(\textbf{S}), \quad \textbf{S} = \textbf{I}_P$$
$$\sigma_m \sim \mathcal{HC}(25), \quad m=1,\dots,M$$
\subsection{Data}
\code{data(USJudgeRatings) \\
Y <- as.matrix(USJudgeRatings) \\
for (m in 1:M) Y[,m] <- CenterScale(Y[,m]) \\
M <- ncol(Y) \#Number of variables \\
N <- nrow(Y) \#Number of records \\
P <- 3 \#Number of factors \\
Lambda <- matrix(NA, P, M) \\
Lambda[upper.tri(Lambda)] <- 0 \\
S <- diag(P) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(F=matrix(0,N,P), Lambda=Lambda, U=S, \\
\hspace*{0.27 in} sigma=rep(0,M)), uppertri=c(0,0,1,0)) \\
pos.F <- grep("F", parm.names) \\
pos.Lambda <- grep("Lambda", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} U <- rwishartc(Data$N, Data$S) \\
\hspace*{0.27 in} F <- as.vector(rmvnpc(Data$N, rep(0,Data$P), U)) \\
\hspace*{0.27 in} Lambda <- rnorm(Data$P*Data$M-Data$P-Data$P*(Data$P-1)/2,0,1) \\
\hspace*{0.27 in} sigma <- runif(Data$M) \\
\hspace*{0.27 in} return(c(F, Lambda, U[upper.tri(U, diag=TRUE)], sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(M=M, N=N, P=P, PGF=PGF, S=S, Y=Y, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.F=pos.F, pos.Lambda=pos.Lambda, \\
\hspace*{0.27 in} pos.sigma=pos.sigma) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} F <- matrix(parm[Data$pos.F], Data$N, Data$P) \\
\hspace*{0.27 in} lambda <- parm[Data$pos.Lambda] \\
\hspace*{0.27 in} U <- as.parm.matrix(U, Data$P, parm, Data, chol=TRUE) \\
\hspace*{0.27 in} diag(U) <- exp(diag(U)) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} F.prior <- sum(dmvnpc(F, rep(0,Data$P), U, log=TRUE)) \\
\hspace*{0.27 in} Lambda.prior <- sum(dnorm(lambda, 0, 1, log=TRUE)) \\
\hspace*{0.27 in} U.prior <- dwishartc(U, Data$N, Data$S, log=TRUE) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} Lambda <- matrix(1, Data$P, Data$M) \\
\hspace*{0.27 in} Lambda[lower.tri(Lambda)] <- 0 \\
\hspace*{0.27 in} Lambda[upper.tri(Lambda)] <- lambda \\
\hspace*{0.62 in} mu <- tcrossprod(F, t(Lambda)) \\
\hspace*{0.27 in} Sigma <- matrix(sigma, Data$N, Data$M, byrow=TRUE) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu, Sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + F.prior + Lambda.prior + U.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.27 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,N*P), rep(0,P*M-P-P*(P-1)/2), rep(0,P*(P-1)/2+P), \\
\hspace*{0.27 in} rep(1,M))}

\section{Factor Analysis, Exploratory Ordinal} \label{eofa}
This exploratory ordinal factor analysis (EOFA) model form is also suitable for collaborative filtering.
\subsection{Form}
$$\textbf{Y}_{i,m} \sim \mathcal{CAT}(\textbf{P}_{i,m,1:K}), \quad i=1,\dots,N, \quad m=1,\dots,M$$
$$\textbf{P}_{,,K} = 1 - Q_{,,(K-1)}$$
$$\textbf{P}_{,,k} = |Q_{,,k} - Q_{,,(k-1)}|, \quad k=2,\dots,(K-1)$$
$$\textbf{P}_{,,1} = Q_{,,1}$$
$$Q = \phi(\mu)$$
$$\mu_{,,k} = \alpha_k - \textbf{F} \Lambda, \quad k=1,\dots,(K-1)$$
$$\textbf{F}_{i,1:P} \sim \mathcal{N}_P(0, \Omega^{-1}), \quad i=1,\dots,N$$
$$\gamma_p = 0, \quad p=1,\dots,P$$
$$\Lambda_{p,m} \sim \mathcal{N}(0, 1), \quad p=1,\dots,P, \quad m=(p+1),\dots,M$$
$$\Omega \sim \mathcal{W}_N(\textbf{S}), \quad \textbf{S} = \textbf{I}_P$$
$$\alpha_k \sim \mathcal{N}(0, 1) \in [(k-1),k] \in [-5,5], \quad k=2,\dots,(K-1)$$
\subsection{Data}
\code{M <- 10 \#Number of variables \\
N <- 20 \#Number of records \\
K <- 3 \#Number of discrete values \\
P <- 3 \#Number of factors \\
alpha <- sort(rnorm(K-1)) \\
Lambda <- matrix(1, P, M) \\
Lambda[lower.tri(Lambda)] <- 0 \\
Lambda[upper.tri(Lambda)] <- rnorm(P*M-P-P*(P-1)/2) \\
Omega <- runif(P) \\
F <- rmvnp(N, rep(0,P), Omega) \\
mu <- aperm(array(alpha, dim=c(K-1, M, N)), perm=c(3,2,1)) \\
mu <- mu - array(tcrossprod(F, t(Lambda)), dim=c(N, M, K-1)) \\
Pr <- Q <- pnorm(mu) \\
Pr[ , , -1] <- abs(Q[ , , -1] - Q[ , , -(K-1)]) \\
Pr <- array(Pr, dim=c(N, M, K)) \\
Pr[ , , K] <- 1 - Q[ , , (K-1)] \\
dim(Pr) <- c(N*M, K) \\
Y <- matrix(rcat(nrow(Pr), Pr), N, M) \#Make sure Y has all values \\
S <- diag(P) \\
Lambda <- matrix(0, P, M) \\
Lambda[lower.tri(Lambda, diag=TRUE)] <- NA \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(F=matrix(0,N,P), Omega=rep(0,P), \\
\hspace*{0.27 in} Lambda=Lambda, alpha=rep(0,K-1))) \\
pos.F <- grep("F", parm.names) \\
pos.Omega <- grep("Omega", parm.names) \\
pos.Lambda <- grep("Lambda", parm.names) \\
pos.alpha <- grep("alpha", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} Omega <- runif(Data$P) \\
\hspace*{0.27 in} F <- as.vector(rmvnp(Data$N, rep(0,Data$P), diag(Omega))) \\
\hspace*{0.27 in} Lambda <- rnorm(Data$P*Data$M-Data$P-Data$P*(Data$P-1)/2) \\
\hspace*{0.27 in} alpha <- sort(rnorm(Data$K-1)) \\
\hspace*{0.27 in} return(c(F, Omega, Lambda, alpha)) \\
\hspace*{0.27 in} \} \\
MyData <- list(K=K, M=M, N=N, P=P, PGF=PGF, S=S, Y=Y, \\
\hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.F=pos.F, \\
\hspace*{0.27 in} pos.Omega=pos.Omega, pos.Lambda=pos.Lambda, pos.alpha=pos.alpha) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} F <- matrix(parm[Data$pos.F], Data$N, Data$P) \\
\hspace*{0.27 in} Omega <- interval(parm[Data$pos.Omega], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.Omega] <- Omega \\
\hspace*{0.27 in} lambda <- parm[Data$pos.Lambda] \\
\hspace*{0.27 in} alpha <- sort(interval(parm[Data$pos.alpha], -5, 5)) \\
\hspace*{0.27 in} parm[Data$pos.alpha] <- alpha \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} F.prior <- sum(dmvnp(F, rep(0,Data$P), diag(Omega), log=TRUE)) \\
\hspace*{0.27 in} Omega.prior <- dwishart(diag(Omega), Data$N, Data$S, log=TRUE) \\
\hspace*{0.27 in} Lambda.prior <- sum(dnorm(lambda, 0, 1, log=TRUE)) \\
\hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 10, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} Lambda <- matrix(1, Data$P, Data$M) \\
\hspace*{0.27 in} Lambda[lower.tri(Lambda)] <- 0 \\
\hspace*{0.27 in} Lambda[upper.tri(Lambda)] <- lambda \\
\hspace*{0.27 in} mu <- aperm(array(alpha, dim=c(Data$K-1, Data$M, Data$N)), \\
\hspace*{0.62 in} perm=c(3,2,1)) \\
\hspace*{0.27 in} mu <- mu - array(tcrossprod(F, t(Lambda)), \\
\hspace*{0.62 in} dim=c(Data$N, Data$M, Data$K-1)) \\
\hspace*{0.27 in} P <- Q <- pnorm(mu) \\
\hspace*{0.27 in} P[ , , -1] <- abs(Q[ , , -1] - Q[ , , -(Data$K-1)]) \\
\hspace*{0.27 in} P <- array(P, dim=c(Data$N, Data$M, Data$K)) \\
\hspace*{0.27 in} P[ , , Data$K] <- 1 - Q[ , , (Data$K-1)] \\
\hspace*{0.27 in} y <- as.vector(Data$Y) \\
\hspace*{0.27 in} dim(P) <- c(Data$N*Data$M, Data$K) \\
\hspace*{0.27 in} LL <- sum(dcat(y, P, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + F.prior + Omega.prior + Lambda.prior + alpha.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=matrix(rcat(nrow(P), P), Data$N, Data$M), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \}
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,N*P), rep(0,P), rep(0,P*M-P-P*(P-1)/2), \\
\hspace*{0.27 in} seq(from=-1, to=1, len=K-1))
}

\section{Factor Regression} \label{factor.reg}
This example of factor regression is constrained to the case where the number of factors is equal to the number of independent variables (IVs) less the intercept. The purpose of this form of factor regression is to orthogonalize the IVs with respect to $\textbf{y}$, rather than variable reduction. This method is the combination of confirmatory factor analysis in section \ref{cfa} and linear regression in section \ref{linear.reg}.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\nu, \sigma^2_{J+1})$$
$$\nu = \textbf{F} \beta$$
$$\mu_{i,1} = 1$$
$$\mu_{i,j+1} = \mu_{i,j}, \quad j=1,\dots,J$$
$$\textbf{X}_{i,j} \sim \mathcal{N}(\mu_{i,j}, \sigma^2_j), \quad i=1,\dots,N, \quad j=2,\dots,J$$
$$\mu_{i,j} = \lambda_j \textbf{F}_{i,j}, \quad i=1,\dots,N, \quad j=2,\dots,J$$
$$\textbf{F}_{i,1:J} \sim \mathcal{N}_{J-1}(0, \Omega^{-1}), \quad i=1,\dots,N$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\lambda_j \sim \mathcal{N}(0, 1), \quad j=1,\dots,(J-1)$$
$$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,(J+1)$$
$$\Omega \sim \mathcal{W}_N(\textbf{S}), \quad \textbf{S} = \textbf{I}_J$$
\subsection{Data}
\code{data(demonsnacks) \\
N <- nrow(demonsnacks) \\
y <- log(demonsnacks$Calories) \\
X <- as.matrix(log(demonsnacks[,c(1,4,10)]+1)) \\
J <- ncol(X) \\
for (j in 1:J) X[,j] <- CenterScale(X[,j]) \\
S <- diag(J) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J+1), lambda=rep(0,J), \\
\hspace*{0.27 in} sigma=rep(0,J+1), F=matrix(0,N,J), Omega=rep(0,J))) \\
pos.beta <- grep("beta", parm.names) \\
pos.lambda <- grep("lambda", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
pos.F <- grep("F", parm.names) \\
pos.Omega <- grep("Omega", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J+1) \\
\hspace*{0.27 in} lambda <- rnorm(Data$J) \\
\hspace*{0.27 in} sigma <- runif(Data$J+1) \\
\hspace*{0.27 in} Omega <- runif(Data$J) \\
\hspace*{0.27 in} F <- as.vector(rmvnp(Data$N, rep(0,Data$J), diag(Omega))) \\
\hspace*{0.27 in} return(c(beta, lambda, sigma, F, Omega)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, N=N, PGF=PGF, S=S, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.lambda=pos.lambda, \\
\hspace*{0.27 in} pos.sigma=pos.sigma, pos.F=pos.F, pos.Omega=pos.Omega, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} lambda <- parm[Data$pos.lambda] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} F <- matrix(Data$pos.F], Data$N, Data$J) \\
\hspace*{0.27 in} Omega <- interval(parm[Data$pos.Omega], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.Omega] <- Omega \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} lambda.prior <- sum(dnorm(lambda, 0, 1, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} F.prior <- sum(dmvnp(F, rep(0,Data$J), diag(Omega), log=TRUE)) \\
\hspace*{0.27 in} Omega.prior <- dwishart(diag(Omega), Data$N, Data$S, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- F * matrix(lambda, Data$N, Data$J, byrow=TRUE) \\
\hspace*{0.27 in} nu <- tcrossprod(cbind(1,F), t(beta)) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$X, mu, matrix(sigma[1:Data$J], Data$N, Data$J, \\
\hspace*{0.62 in} byrow=TRUE), log=TRUE)) \\
\hspace*{0.27 in} LL <- LL + dnorm(Data$y, nu, sigma[Data$J+1], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + lambda.prior + sigma.prior + F.prior \\
\hspace*{0.62 in} Omega.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(Data$N, nu, sigma[Data$J+1]), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J+1), rep(0,J), rep(0,J+1), rep(0,N*J), rep(1,J))}

\section{Gamma Regression} \label{gamma.reg}
\subsection{Form}
$$\textbf{y} \sim \mathcal{G}(\lambda \tau, \tau)$$
$$\lambda = \exp(\textbf{X} \beta)$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\tau \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{N <- 20 \\
J <- 3 \\
X <- matrix(runif(N*J,-2,2),N,J); X[,1] <- 1 \\
beta <- runif(J,-2,2) \\
y <- round(exp(tcrossprod(X, t(beta)))) + 0.1 \#Must be > 0 \\
mon.names <- c("LP","sigma2") \\
parm.names <- as.parm.names(list(beta=rep(0,J), tau=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.tau <- grep("tau", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} tau <- runif(1) \\
\hspace*{0.27 in} return(c(beta, tau)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, N=N, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.tau=pos.tau, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.tau] <- tau \\
\hspace*{0.27 in} sigma2 <- 1/tau \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} lambda <- exp(tcrossprod(Data$X, t(beta))) \\
\hspace*{0.27 in} LL <- sum(dgamma(Data$y, tau*lambda, tau, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + tau.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,sigma2), \\
\hspace*{0.62 in} yhat=rgamma(nrow(lambda), tau*lambda, tau), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 1)}

\section{Geographically Weighted Regression} \label{gwr}
\subsection{Form}
$$\textbf{y}_{i,k} \sim \mathcal{N}(\mu_{i,k}, \tau^{-1}_{i,k}), \quad i=1,\dots,N, \quad k=1,\dots,N$$
$$\mu_{i,1:N} = \textbf{X} \beta_{i,1:J}$$
$$\tau = \frac{1}{\sigma^2} \textbf{w} \nu$$
$$\textbf{w} = \frac{\exp(-0.5 \textbf{Z}^2)}{\textbf{h}}$$
$$\alpha \sim \mathcal{U}(1.5, 100)$$
$$\beta_{i,j} \sim \mathcal{N}(0, 1000), \quad i=1,\dots,N, \quad j=1,\dots,J$$
$$\textbf{h} \sim \mathcal{N}(0.1, 1000) \in [0.1, \infty]$$
$$\nu_{i,k} \sim \mathcal{G}(\alpha, 2), \quad i=1,\dots,N, \quad k=1,\dots,N$$
$$\sigma_i \sim \mathcal{HC}(25), \quad i=1,\dots,N$$
\subsection{Data}
\code{crime <-   c(18.802, 32.388, 38.426,  0.178, 15.726, 30.627, 50.732, \\
\hspace*{0.27 in} 26.067, 48.585, 34.001, 36.869, 20.049, 19.146, 18.905, 27.823, \\
\hspace*{0.27 in} 16.241,  0.224, 30.516, 33.705, 40.970, 52.794, 41.968, 39.175, \\
\hspace*{0.27 in} 53.711, 25.962, 22.541, 26.645, 29.028, 36.664, 42.445, 56.920, \\
\hspace*{0.27 in} 61.299, 60.750, 68.892, 38.298, 54.839, 56.706, 62.275, 46.716, \\
\hspace*{0.27 in} 57.066, 54.522, 43.962, 40.074, 23.974, 17.677, 14.306, 19.101, \\
\hspace*{0.27 in} 16.531, 16.492) \\
income <-  c(21.232,  4.477, 11.337,  8.438, 19.531, 15.956, 11.252, \\
\hspace*{0.27 in} 16.029,  9.873, 13.598,  9.798, 21.155, 18.942, 22.207, 18.950, \\
\hspace*{0.27 in} 29.833, 31.070, 17.586, 11.709,  8.085, 10.822,  9.918, 12.814, \\
\hspace*{0.27 in} 11.107, 16.961, 18.796, 11.813, 14.135, 13.380, 17.017,  7.856, \\
\hspace*{0.27 in}  8.461,  8.681, 13.906, 14.236,  7.625, 10.048,  7.467,  9.549, \\
\hspace*{0.27 in}  9.963, 11.618, 13.185, 10.655, 14.948, 16.940, 18.739, 18.477, \\
\hspace*{0.27 in} 18.324, 25.873) \\
housing <- c(44.567, 33.200, 37.125, 75.000, 80.467, 26.350, 23.225, \\
\hspace*{0.27 in} 28.750, 18.000, 96.400, 41.750, 47.733, 40.300, 42.100, 42.500, \\
\hspace*{0.27 in} 61.950, 81.267, 52.600, 30.450, 20.300, 34.100, 23.600, 27.000, \\
\hspace*{0.27 in} 22.700, 33.500, 35.800, 26.800, 27.733, 25.700, 43.300, 22.850, \\
\hspace*{0.27 in} 17.900, 32.500, 22.500, 53.200, 18.800, 19.900, 19.700, 41.700, \\
\hspace*{0.27 in} 42.900, 30.600, 60.000, 19.975, 28.450, 31.800, 36.300, 39.600, \\
\hspace*{0.27 in} 76.100, 44.333) \\
easting <- c(35.62, 36.50, 36.71, 33.36, 38.80, 39.82, 40.01, 43.75, \\
\hspace*{0.27 in} 39.61, 47.61, 48.58, 49.61, 50.11, 51.24, 50.89, 48.44, 46.73, \\
\hspace*{0.27 in} 43.44, 43.37, 41.13, 43.95, 44.10, 43.70, 41.04, 43.23, 42.67, \\
\hspace*{0.27 in} 41.21, 39.32, 41.09, 38.3,  41.31, 39.36, 39.72, 38.29, 36.60, \\
\hspace*{0.27 in} 37.60, 37.13, 37.85, 35.95, 35.72, 35.76, 36.15, 34.08, 30.32, \\
\hspace*{0.27 in} 27.94, 27.27, 24.25, 25.47, 29.02) \\
northing <- c(42.38, 40.52, 38.71, 38.41, 44.07, 41.18, 38.00, 39.28, \\
\hspace*{0.27 in} 34.91, 36.42, 34.46, 32.65, 29.91, 27.80, 25.24, 27.93, 31.91, \\
\hspace*{0.27 in} 35.92, 33.46, 33.14, 31.61, 30.40, 29.18, 28.78, 27.31, 24.96, \\
\hspace*{0.27 in} 25.90, 25.85, 27.49, 28.82, 30.90, 32.88, 30.64, 30.35, 32.09, \\
\hspace*{0.27 in} 34.08, 36.12, 36.30, 36.40, 35.60, 34.66, 33.92, 30.42, 28.26, \\
\hspace*{0.27 in} 29.85, 28.21, 26.69, 25.71, 26.58) \\
N <- length(crime) \\
J <- 3 \#Number of predictors, including the intercept \\
X <- matrix(c(rep(1,N), income, housing),N,J) \\
D <- as.matrix(dist(cbind(northing,easting), diag=TRUE, upper=TRUE)) \\
Z <- D / sd(as.vector(D)) \\
y <- matrix(0,N,N); for (i in 1:N) \{for (k in 1:N) \{y[i,k] <- crime[k]\}\} \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=0, beta=matrix(0,N,J), H=0, \\
\hspace*{0.27 in} nu=matrix(0,N,N), sigma=rep(0,N))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.H <- grep("H", parm.names) \\
pos.nu <- grep("nu", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- runif(1,1.5,100) \\
\hspace*{0.27 in} beta <- rnorm(Data$N*Data$J) \\
\hspace*{0.27 in} H <- runif(1,0.1,1000) \\
\hspace*{0.27 in} nu <- rgamma(Data$N*Data$N,alpha,2) \\
\hspace*{0.27 in} sigma <- runif(Data$N) \\
\hspace*{0.27 in} return(c(alpha, beta, H, nu, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, N=N, PGF=PGF, X=X, Z=Z, latitude=northing, \\
\hspace*{0.27 in} longitude=easting, mon.names=mon.names, parm.names=parm.names, \\
\hspace*{0.27 in} pos.alpha=pos.alpha, pos.beta=pos.beta, pos.H=pos.H, pos.nu=pos.nu, \\
\hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- interval(parm[Data$pos.alpha], 1.5, 100) \\
\hspace*{0.27 in} parm[Data$pos.alpha] <- alpha \\
\hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$N, Data$J) \\
\hspace*{0.27 in} parm[Data$pos.H] <- H <- interval(parm[Data$pos.H], 0.1, Inf) \\
\hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\
\hspace*{0.27 in} nu <- matrix(nu, Data$N, Data$N)
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dunif(alpha, 1.5, 100, log=TRUE) \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} h.prior <- dhalfnorm(H-0.1, 1000, log=TRUE) \\
\hspace*{0.27 in} nu.prior <- sum(dgamma(nu, alpha, 2, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} w <- exp(-0.5 * Data$Z\textasciicircum 2) / H \\
\hspace*{0.27 in} tau <- (1/sigma\textasciicircum 2) * w * nu \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) \\
\hspace*{0.27 in} LL <- sum(dnormp(Data$y, mu, tau, log=TRUE)) \\
\hspace*{0.27 in} \#WSE <- w * nu * (Data$y - mu)\textasciicircum 2; w.y <- w * nu * Data$y \\
\hspace*{0.27 in} \#WMSE <- rowMeans(WSE); y.w <- rowSums(w.y) / rowSums(w) \\
\hspace*{0.27 in} \#LAR2 <- 1 - WMSE / sd(y.w)\textasciicircum 2 \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + h.prior + nu.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnormp(prod(dim(mu)), mu, tau), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(runif(1,1.5,100), rep(0,N*J), 1, rep(1,N*N), rep(1,N))}

\section{Hidden Markov Model} \label{hmm}
\subsection{Form}
This introductory hidden Markov model (HMM) includes $N$ discrete states.
$$\textbf{y}_t \sim \mathcal{N}(\mu_\theta, \sigma^2_\theta), \quad t=1,\dots,T$$
$$\mu \sim \mathcal{N}(\mu_0, \sigma^2)$$
$$\sigma^2 \sim \mathcal{HC}(25)$$
$$\theta_t \sim \mathcal{CAT}(\phi_{\theta_{t-1},1:N}), \quad t=1,\dots,T$$
$$\phi_{i,1:N} \sim \mathcal{D}(\alpha_{1:N}), \quad i=1,\dots,N$$
$$\mu_0 \sim \mathcal{N}(0, 1000)$$
$$\sigma^2_0 \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonfx) \\
y <- as.vector(log(as.matrix(demonfx[1:50,1]))) \\
T <- length(y) \#Number of time-periods \\
N <- 2 \#Number of discrete (hidden) states \\
alpha <- matrix(1,N,N) \#Concentration hyperparameter \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(mu0=rep(0,N), mu1=rep(0,N), \\
\hspace*{0.27 in} phi=matrix(0,N,N), sigma2=rep(0,N), theta=rep(0,T))) \\
pos.mu0 <- grep("mu0", parm.names) \\
pos.mu1 <- grep("mu1", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.sigma2 <- grep("sigma2", parm.names) \\
pos.theta <- grep("theta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} mu0 <- sort(runif(Data$N, min(Data$y), max(Data$y))) \\
\hspace*{0.27 in} mu1 <- sort(runif(Data$N, min(Data$y), max(Data$y))) \\
\hspace*{0.27 in} phi <- matrix(runif(Data$N*Data$N), Data$N, Data$N) \\
\hspace*{0.27 in} phi <- as.vector(phi / rowSums(phi)) \\
\hspace*{0.27 in} sigma2 <- runif(Data$N) \\
\hspace*{0.27 in} theta <- rcat(Data$T, rep(1/Data$N,Data$N)) \\
\hspace*{0.27 in} return(c(mu0, mu1, phi, sigma2, theta)) \\
\hspace*{0.27 in} \} \\
MyData <- list(N=N, PGF=PGF, T=T, alpha=alpha, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.mu0=pos.mu0, pos.mu1=pos.mu1, \\
\hspace*{0.27 in} pos.phi=pos.phi, pos.sigma2=pos.sigma2, pos.theta=pos.theta, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} mu0 <- interval(parm[Data$pos.mu0], min(Data$y), max(Data$y)) \\
\hspace*{0.27 in} parm[Data$pos.mu0] <- mu0 \\
\hspace*{0.27 in} mu <- interval(parm[Data$pos.mu1], min(Data$y), max(Data$y)) \\
\hspace*{0.27 in} parm[Data$pos.mu1] <- mu <- sort(mu) \\
\hspace*{0.27 in} phi <- matrix(abs(parm[Data$pos.phi]), Data$N, Data$N) \\
\hspace*{0.27 in} parm[Data$pos.phi] <- phi <- phi / rowSums(phi) \\
\hspace*{0.27 in} sigma2 <- interval(parm[Data$pos.sigma2], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma2] <- sigma2 \\
\hspace*{0.27 in} theta <- parm[Data$pos.theta] \\
\hspace*{0.27 in} \#\#\# Log-Hyperprior \\
\hspace*{0.27 in} mu0.prior <- sum(dnormv(mu0, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} mu.prior <- sum(dnormv(mu, mu0, sigma2, log=TRUE)) \\
\hspace*{0.27 in} phi.prior <- 0 \\
\hspace*{0.27 in} for (i in 1:Data$N) \\
\hspace*{0.62 in} phi.prior <- phi.prior + sum(ddirichlet(phi[i,], Data$alpha[i,], \\
\hspace*{0.95 in} log=TRUE)) \\
\hspace*{0.27 in} sigma2.prior <- sum(dhalfcauchy(sigma2, 25, log=TRUE)) \\
\hspace*{0.27 in} theta.prior <- sum(dcat(theta, rbind(rep(1/Data$N,Data$N), \\
\hspace*{0.62 in} phi[theta[-Data$T],]), log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} LL <- sum(dnormv(Data$y, mu[theta], sigma2[theta], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + mu0.prior + mu.prior + phi.prior + sigma2.prior + theta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnormv(length(theta), mu[theta], sigma2[theta]), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(sort(runif(N, min(y), max(y))), \\
\hspace*{0.27 in} sort(runif(N, min(y), max(y))), runif(N*N), runif(N), \\
\hspace*{0.27 in} rcat(T, rep(1/N,N)))}

\section{Inverse Gaussian Regression} \label{ig.reg}
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}^{-1}(\mu, \lambda)$$
$$\mu = \exp(\textbf{X}\beta) + C$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\lambda \sim \mathcal{HC}(25)$$
where $C$ is a small constant, such as 1.0E-10. 
\subsection{Data}
\code{N <- 100 \\
J <- 3 \#Number of predictors, including the intercept \\
X <- matrix(1,N,J) \\
for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\
beta.orig <- runif(J,-3,3) \\
e <- rnorm(N,0,0.1) \\
y <- exp(tcrossprod(X, t(beta.orig)) + e) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), lambda=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.lambda <- grep("lambda", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} lambda <- runif(1) \\
\hspace*{0.27 in} return(c(beta, lambda)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.lambda=pos.lambda, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} lambda <- interval(parm[Data$pos.lambda], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.lambda] <- lambda \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} lambda.prior <- dhalfcauchy(lambda, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- exp(tcrossprod(Data$X, t(beta))) + 1.0E-10 \\
\hspace*{0.27 in} LL <- sum(dinvgaussian(Data$y, mu, lambda, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + lambda.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rinvgaussian(length(mu), mu, lambda), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 1)}

\section{Kriging} \label{kriging}
This is an example of universal kriging of $\textbf{y}$ given $\textbf{X}$, regression effects $\beta$, and spatial effects $\zeta$. Euclidean distance between spatial coordinates (longitude and latitude) is used for each of $i=1,\dots,N$ records of $\textbf{y}$. An additional record is created from the same data-generating process to compare the accuracy of interpolation. For the spatial component, $\phi$ is the rate of spatial decay and $\kappa$ is the scale. $\kappa$ is often difficult to identify, so it is set to 1 (Gaussian), but may be allowed to vary up to 2 (Exponential). In practice, $\phi$ is also often difficult to identify. While $\Sigma$ is spatial covariance, spatial correlation is $\rho = \exp(-\phi \textbf{D})$. To extend this to a large data set, consider the predictive process kriging example in section \ref{kriging.pp}.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2_1)$$
$$ \mu = \textbf{X} \beta + \zeta$$
$$ \textbf{y}^{new} = \textbf{X} \beta + \sum^N_{i=1} \left ( \frac{\rho_i}{\sum \rho} \zeta_i \right )$$
$$ \rho = \exp(-\phi \textbf{D}^{new})^\kappa$$
$$ \zeta \sim \mathcal{N}_N(\zeta_\mu, \Sigma)$$
$$ \Sigma = \sigma^2_2 \exp(-\phi \textbf{D})^\kappa$$
$$ \beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,2$$
$$ \sigma_j \sim \mathcal{HC}(25) \in [0.1,10], \quad j=1,\dots,2$$
$$ \phi \sim \mathcal{U}(1, 5)$$
$$ \zeta_\mu = 0$$
$$ \kappa = 1$$
\subsection{Data}
\code{N <- 20 \\
longitude <- runif(N+1,0,100) \\
latitude <- runif(N+1,0,100) \\
D <- as.matrix(dist(cbind(longitude,latitude), diag=TRUE, upper=TRUE)) \\
Sigma <- 10000 * exp(-1.5 * D) \\
zeta <- colMeans(rmvn(1000, rep(0,N+1), Sigma)) \\
beta <- c(50,2) \\
X <- matrix(runif((N+1)*2,-2,2),(N+1),2); X[,1] <- 1 \\
mu <- as.vector(tcrossprod(X, t(beta))) \\
y <- mu + zeta \\
longitude.new <- longitude[N+1]; latitude.new <- latitude[N+1] \\
Xnew <- X[N+1,]; ynew <- y[N+1] \\
longitude <- longitude[1:N]; latitude <- latitude[1:N] \\
X <- X[1:N,]; y <- y[1:N] \\
D <- as.matrix(dist(cbind(longitude,latitude), diag=TRUE, upper=TRUE)) \\
D.new <- sqrt((longitude - longitude.new)\textasciicircum 2 + (latitude - latitude.new)\textasciicircum 2) \\
mon.names <- c("LP","ynew") \\
parm.names <- as.parm.names(list(zeta=rep(0,N), beta=rep(0,2), \\
\hspace*{0.27 in} sigma=rep(0,2), phi=0)) \\
pos.zeta <- grep("zeta", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(2) \\
\hspace*{0.27 in} sigma <- runif(2,0.1,10) \\
\hspace*{0.27 in} phi <- runif(1,1,5) \\
\hspace*{0.27 in} kappa <- 1 \\
\hspace*{0.27 in} zeta <- rmvn(1, rep(0,Data$N), \\
\hspace*{0.62 in} sigma[2]*sigma[2]*exp(-phi*Data$D)\textasciicircum kappa) \\
\hspace*{0.27 in} return(c(zeta, beta, sigma, phi)) \\
\hspace*{0.27 in} \} \\
MyData <- list(D=D, D.new=D.new, latitude=latitude, longitude=longitude, \\
\hspace*{0.27 in} N=N, PGF=PGF, X=X, Xnew=Xnew, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.zeta=pos.zeta, pos.beta=pos.beta, \\
\hspace*{0.27 in} pos.sigma=pos.sigma, pos.phi=pos.phi, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} zeta <- parm[Data$pos.zeta] \\
\hspace*{0.27 in} kappa <- 1 \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 0.1, 10) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1, 5) \\
\hspace*{0.27 in} Sigma <- sigma[2]*sigma[2] * exp(-phi * Data$D)\textasciicircum kappa \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} zeta.prior <- dmvn(zeta, rep(0, Data$N), Sigma, log=TRUE) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma - 1, 25, log=TRUE)) \\
\hspace*{0.27 in} phi.prior <- dunif(phi, 1, 5, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Interpolation \\
\hspace*{0.27 in} rho <- exp(-phi * Data$D.new)\textasciicircum kappa \\
\hspace*{0.27 in} ynew <- rnorm(1, sum(beta * Data$Xnew) + sum(rho / sum(rho) * zeta), \\
\hspace*{0.62 in} sigma[1]) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) + zeta \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + zeta.prior + sigma.prior + phi.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,ynew), \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,N), rep(0,2), rep(1,2), 1)}

\section{Kriging, Predictive Process} \label{kriging.pp}
The first $K$ of $N$ records in $\textbf{y}$ are used as knots for the parent process, and the predictive process involves records $(K+1),\dots,N$. For more information on kriging, see section \ref{kriging}.
\subsection{Form}
$$ \textbf{y} \sim \mathcal{N}(\mu, \sigma^2_1)$$
$$ \mu_{1:K} = \textbf{X}_{1:K,1:J} \beta + \zeta$$
$$ \mu_{(K+1):N} = \textbf{X}_{(K+1):N,1:J} \beta + \sum^{N-K}_{p=1} \frac{\lambda_{p,1:K}}{\sum^{N-K}_{q=1} \lambda_{q,1:K}} \zeta^T$$
$$ \lambda = \exp(-\phi \textbf{D}_P)^\kappa$$
$$ \textbf{y}^{new} = \textbf{X} \beta + \sum^K_{k=1} (\frac{\rho_k}{\sum \rho} \zeta_k)$$
$$ \rho = \exp(-\phi \textbf{D}^{new})^\kappa$$
$$ \zeta \sim \mathcal{N}_K(0, \Sigma)$$
$$ \Sigma = \sigma^2_2 \exp(-\phi \textbf{D})^\kappa$$
$$ \beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,2$$
$$ \sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,2$$
$$ \phi \sim \mathrm{N}(0, 1000) \in [1, 5]$$
$$ \kappa = 1$$
\subsection{Data}
\code{N <- 100 \\
K <- 30 \#Number of knots \\
longitude <- runif(N+1,0,100) \\
latitude <- runif(N+1,0,100) \\
D <- as.matrix(dist(cbind(longitude,latitude), diag=TRUE, upper=TRUE)) \\
Sigma <- 10000 * exp(-1.5 * D) \\
zeta <- colMeans(rmvn(1000, rep(0,N+1), Sigma)) \\
beta <- c(50,2) \\
X <- matrix(runif((N+1)*2,-2,2),(N+1),2); X[,1] <- 1 \\
mu <- as.vector(tcrossprod(X, t(beta))) \\
y <- mu + zeta \\
longitude.new <- longitude[N+1]; latitude.new <- latitude[N+1] \\
Xnew <- X[N+1,]; ynew <- y[N+1] \\
longitude <- longitude[1:N]; latitude <- latitude[1:N] \\
X <- X[1:N,]; y <- y[1:N] \\
D <- as.matrix(dist(cbind(longitude[1:K],latitude[1:K]), diag=TRUE, \\
\hspace*{0.27 in} upper=TRUE)) \\
D.P <- matrix(0, N-K, K) \\
for (i in (K+1):N) \{ \\
\hspace*{0.27 in} D.P[K+1-i,] <- sqrt((longitude[1:K] - longitude[i])\textasciicircum 2 + \\
\hspace*{0.62 in} (latitude[1:K] - latitude[i])\textasciicircum 2)\} \\
D.new <- sqrt((longitude[1:K] - longitude.new)\textasciicircum 2 + \\
\hspace*{0.27 in} (latitude[1:K] - latitude.new)\textasciicircum 2) \\
mon.names <- c("LP","ynew") \\
parm.names <- as.parm.names(list(zeta=rep(0,K), beta=rep(0,2), \\
\hspace*{0.27 in} sigma=rep(0,2), phi=0)) \\
pos.zeta <- grep("zeta", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(2) \\
\hspace*{0.27 in} sigma <- runif(2,0.1,10) \\
\hspace*{0.27 in} phi <- runif(1,1,5) \\
\hspace*{0.27 in} kappa <- 1 \\
\hspace*{0.27 in} zeta <- rmvn(1, rep(0,Data$K), \\
\hspace*{0.62 in} sigma[2]*sigma[2]*exp(-phi*Data$D)\textasciicircum kappa) \\
\hspace*{0.27 in} return(c(zeta, beta, sigma, phi)) \\
\hspace*{0.27 in} \} \\
MyData <- list(D=D, D.new=D.new, D.P=D.P, K=K, N=N, PGF=PGF, X=X, \\
\hspace*{0.27 in} Xnew=Xnew, latitude=latitude, longitude=longitude, \\
\hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.zeta=pos.zeta, \\
\hspace*{0.27 in} pos.beta=pos.beta, pos.sigma=pos.sigma, pos.phi=pos.phi, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} zeta <- parm[Data$pos.zeta] \\
\hspace*{0.27 in} kappa <- 1 \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1, 5) \\
\hspace*{0.27 in} Sigma <- sigma[2]*sigma[2] * exp(-phi * Data$D)\textasciicircum kappa \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} zeta.prior <- dmvn(zeta, rep(0, Data$K), Sigma, log=TRUE) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma - 1, 25, log=TRUE)) \\
\hspace*{0.27 in} phi.prior <- dunif(phi, 1, 5, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Interpolation \\
\hspace*{0.27 in} rho <- exp(-phi * Data$D.new)\textasciicircum kappa \\
\hspace*{0.27 in} ynew <- rnorm(1, sum(beta * Data$Xnew) + sum(rho / sum(rho) * zeta), \\
\hspace*{0.62 in} sigma) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} mu[1:Data$K] <- mu[1:Data$K] + zeta \\
\hspace*{0.27 in} lambda <- exp(-phi * Data$D.P)\textasciicircum kappa \\
\hspace*{0.27 in} mu[(Data$K+1):Data$N] <- mu[(Data$K+1):Data$N] + \\
\hspace*{0.62 in} rowSums(lambda / rowSums(lambda) * \\
\hspace*{0.62 in} matrix(zeta, Data$N - Data$K, Data$K, byrow=TRUE)) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + zeta.prior + sigma.prior + phi.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,ynew), \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,K), c(mean(y), 0), rep(1,2), 3)}

\section{Laplace Regression} \label{laplace.reg}
This linear regression specifies that $\textbf{y}$ is Laplace-distributed, where it is usually Gaussian or normally-distributed.  It has been claimed that it should be surprising that the normal distribution became the standard, when the Laplace distribution usually fits better and has wider tails \citep{kotz01}. Another popular alternative is to use the t-distribution (see Robust Regression in section \ref{robust.reg}), though it is more computationally expensive to estimate, because it has three parameters.  The Laplace distribution has only two parameters, location and scale like the normal distribution, and is computationally easier to fit.  This example could be taken one step further, and the parameter vector $\beta$ could be Laplace-distributed.  Laplace's Demon recommends that users experiment with replacing the normal distribution with the Laplace distribution.
\subsection{Form}
$$\textbf{y} \sim \mathcal{L}(\mu, \sigma^2)$$
$$\mu = \textbf{X}\beta$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{N <- 10000 \\
J <- 5 \\
X <- matrix(1,N,J) \\
for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\
beta <- runif(J,-3,3) \\
e <- rlaplace(N,0,0.1) \\
y <- tcrossprod(X, t(beta)) + e \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(beta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} LL <- sum(dlaplace(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rlaplace(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 1)}

\section{Latent Dirichlet Allocation} \label{lda}
\subsection{Form}
$$\textbf{Y}_{m,n} \sim \mathcal{CAT}(\phi[\textbf{Z}_{m,n},]), \quad m=1,\dots,M, \quad n=1,\dots,N$$
$$\textbf{Z}_{m,n} \sim \mathcal{CAT}(\theta_{m,1:K})$$
$$\phi_{k,v} \sim \mathcal{D}(\beta)$$
$$\theta_{m,k} \sim \mathcal{D}(\alpha)$$
$$\alpha_k = 1, \quad k=1,\dots,K$$
$$\beta_v = 1, \quad v=1,\dots,V$$
\subsection{Data}
\code{K <- 2 \#Number of (latent) topics \\
M <- 4 \#Number of documents in corpus \\
N <- 15 \#Maximum number of (used) words per document \\
V <- 5 \#Maximum number of occurrences of any word (Vocabulary size) \\
Y <- matrix(rcat(M*N,rep(1/V,V)), M, N) \\
rownames(Y) <- paste("doc", 1:nrow(Y), sep="") \\
colnames(Y) <- paste("word", 1:ncol(Y), sep="") \\
\#Note: Y is usually represented as w, a matrix of word counts. \\
if(min(Y) == 0) Y <- Y + 1 \#A zero cannot occur, Y must be 1,2,...,V. \\
V <- max(Y) \#Maximum number of occurrences of any word (Vocabulary size) \\
alpha <- rep(1,K) \# hyperparameters (constant) \\
beta <- rep(1,V) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(phi=matrix(0,K,V), theta=matrix(0,M,K), \\
\hspace*{0.27 in} Z=matrix(0,M,N))) \\
pos.phi <- grep("phi", parm.names) \\
pos.theta <- grep("theta", parm.names) \\
pos.Z <- grep("Z", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} phi <- matrix(runif(Data$J*Data$V), Data$K, Data$V) \\
\hspace*{0.27 in} phi <- phi / rowSums(phi) \\
\hspace*{0.27 in} theta <- matrix(runif(Data$M*Data$K), Data$M, Data$K) \\
\hspace*{0.27 in} theta <- theta / rowSums(theta) \\
\hspace*{0.27 in} z <- rcat(Data$M*Data$N, rep(1/Data$K,Data$K)) \\
\hspace*{0.27 in} return(c(as.vector(phi), as.vector(theta), z))\} \\
MyData <- list(K=K, M=M, N=N, PGF=PGF, V=V, Y=Y, alpha=alpha, beta=beta, \\
\hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.phi=pos.phi, \\
\hspace*{0.27 in} pos.theta=pos.theta, pos.Z=pos.Z) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} phi <- matrix(interval(parm[Data$pos.phi], 0, 1), Data$K, Data$V) \\
\hspace*{0.27 in} phi <- phi / rowSums(phi) \\
\hspace*{0.27 in} parm[Data$pos.phi] <- as.vector(phi) \\
\hspace*{0.27 in} theta <- matrix(interval(parm[Data$pos.theta], 0, 1), Data$M, Data$K) \\
\hspace*{0.27 in} theta <- theta / rowSums(theta) \\
\hspace*{0.27 in} parm[Data$pos.theta] <- as.vector(theta) \\
\hspace*{0.27 in} Z <- matrix(parm[Data$pos.Z], Data$M, Data$N) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} phi.prior <- sum(ddirichlet(phi, beta, log=TRUE)) \\
\hspace*{0.27 in} theta.prior <- sum(ddirichlet(theta, alpha, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} LL <- Z.prior <- 0 \\
\hspace*{0.27 in} Yhat <- Data$Y \\
\hspace*{0.27 in} for (m in 1:Data$M) \{for (n in 1:Data$N) \{ \\
\hspace*{0.62 in} Z.prior + Z.prior + dcat(Z[m,n], theta[m,], log=TRUE) \\
\hspace*{0.62 in} LL <- LL + dcat(Data$Y[m,n], as.vector(phi[Z[m,n],]), log=TRUE) \\
\hspace*{0.62 in} Yhat[m,n] <- rcat(1, as.vector(phi[Z[m,n],]))\}\} \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + phi.prior + theta.prior + Z.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=Yhat, parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \}
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(1/V,K*V), rep(1/K,M*K), rcat(M*N,rep(1/K,K)))}

\section{Linear Regression} \label{linear.reg}
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu = \textbf{X}\beta$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{N <- 10000 \\
J <- 5 \\
X <- matrix(1,N,J) \\
for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\
beta <- runif(J,-3,3) \\
e <- rnorm(N,0,0.1) \\
y <- tcrossprod(X, t(beta)) + e \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(beta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dgamma(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 1)}

\section{Linear Regression, Frequentist} \label{linear.reg.freq}
By eliminating prior probabilities, a frequentist linear regression example is presented. Although frequentism is not endorsed here, the purpose of this example is to illustrate how the \pkg{LaplacesDemon} package can be used for Bayesian or frequentist inference.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu = \textbf{X}\beta$$
\subsection{Data}
\code{N <- 10000 \\
J <- 5 \\
X <- matrix(1,N,J) \\
for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\
beta <- runif(J,-3,3) \\
e <- rnorm(N,0,0.1) \\
y <- tcrossprod(X, t(beta)) + e \\
mon.names <- "LL" \\
parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(beta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma, 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} Modelout <- list(LP=LL, Dev=-2*LL, Monitor=LL, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 1)}

\section{Linear Regression, Hierarchical Bayesian} \label{linear.reg.hb}
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu = \textbf{X}\beta$$
$$\beta_j \sim \mathcal{N}(\gamma, \delta), \quad j=1,\dots,J$$
$$\gamma \sim \mathcal{N}(0, 1000)$$
$$\delta \sim \mathcal{HC}(25)$$
$$\sigma \sim \mathcal{HC}(\tau)$$
$$\tau \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonsnacks) \\
y <- log(demonsnacks$Calories) \\
X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\
J <- ncol(X) \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), gamma=0, delta=0, sigma=0, \\
\hspace*{0.27 in} tau=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
pos.delta <- grep("delta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
pos.tau <- grep("tau", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} gamma <- rnorm(1) \\
\hspace*{0.27 in} delta <- runif(1) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} tau <- runif(1) \\
\hspace*{0.27 in} return(c(beta, gamma, delta, sigma, tau)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, \\
\hspace*{0.27 in} \\ pos.delta=pos.delta, pos.sigma=pos.sigma, pos.tau=pos.tau, y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Hyperparameters \\
\hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\
\hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.delta] <- delta \\
\hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Hyperprior \\
\hspace*{0.27 in} gamma.prior <- dnormv(gamma, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} delta.prior <- dhalfcauchy(delta, 25, log=TRUE) \\
\hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, gamma, delta, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, tau, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + delta.prior + sigma.prior + \\
\hspace*{0.62 in} tau.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 0, rep(1,3))}

\section{Linear Regression, Multilevel} \label{linear.reg.ml}
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu_i = \textbf{X} \beta_{\textbf{m}[i],1:J}$$
$$\beta_{g,1:J} \sim \mathcal{N}_J(\gamma, \Omega^{-1}), \quad g=1,\dots,G$$
$$\Omega \sim \mathcal{W}_{J+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_J$$
$$\gamma_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\sigma \sim \mathcal{HC}(25)$$
where $\textbf{m}$ is a vector of length $N$, and each element indicates the multilevel group ($g=1,\dots,G$) for the associated record.
\subsection{Data}
\code{N <- 30 \\
J <- 2 \#\#\# Number of predictors (including intercept) \\
G <- 2 \#\#\# Number of Multilevel Groups \\
X <- cbind(1, matrix(rnorm(N*(J-1),0,1),N,J-1)) \\
Sigma <- matrix(runif(J*J,-1,1),J,J) \\
diag(Sigma) <- runif(J,1,5) \\
Sigma <- as.positive.definite(Sigma) \\
gamma <- runif(J,-1,1) \\
beta <- matrix(NA,G,J) \\
for (g in 1:G) \{beta[g,] <- rmvn(1, gamma, Sigma)\} \\
m <- rcat(N, rep(1/G,G)) \#\#\# Multilevel group indicator \\
y <- rowSums(beta[m,] * X) + rnorm(N,0,0.1) \\
S <- diag(J) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=matrix(0,G,J), gamma=rep(0,J), \\
\hspace*{0.27 in} sigma=0, U=S), uppertri=c(0,0,0,1)) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} U <- rwishartc(Data$J+1, Data$S) \\
\hspace*{0.27 in} gamma <- rnorm(Data$J) \\
\hspace*{0.27 in} beta <- as.vector(rmvnpc(Data$G, gamma, U)) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(beta, gamma, sigma, U[upper.tri(U, diag=TRUE)])) \\
\hspace*{0.27 in} \} \\
MyData <- list(G=G, J=J, N=N, PGF=PGF, S=S, X=X, m=m, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, \\
\hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$G, Data$J) \\
\hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} U <- as.parm.matrix(U, Data$J, parm, Data, chol=TRUE) \\
\hspace*{0.27 in} diag(U) <- exp(diag(U)) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} U.prior <- dwishartc(U, Data$J+1, Data$S, log=TRUE) \\
\hspace*{0.27 in} beta.prior <- sum(dmvnpc(beta, gamma, U, log=TRUE)) \\
\hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 100, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- rowSums(beta[Data$m,] * Data$X) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + U.prior + beta.prior + gamma.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial.Values}
\code{Initial.Values <- c(rep(0,G*J), rep(0,J), 1, \\
\hspace*{0.27 in} upper.triangle(S, diag=TRUE))}

\section{Linear Regression with Full Missingness} \label{linear.reg.full.miss}
With `full missingness', there are missing values for both the dependent variable (DV) and at least one independent variable (IV). The `full likelihood` approach to full missingness is excellent as long as the model is identifiable. When it is not identifiable, imputation may be done in a previous stage, such as with the \code{MISS} function. In this example, matrix $\alpha$ is for regression effects for IVs, vector $\beta$ is for regression effects for the DV, vector $\gamma$ is for missing values for IVs, and $\delta$ is for missing values for the DV.
\subsection{Form}
$$\textbf{y}^{imp} \sim \mathcal{N}(\nu, \sigma^2_J)$$
$$\textbf{X}^{imp} \sim \mathcal{N}(\mu, \sigma^2_{-J}$$
$$\nu = \textbf{X}^{imp} \beta$$
$$\mu = \textbf{X}^{imp} \alpha$$
\[\textbf{y}^{imp} = \left\{
\begin{array}{l l}
 $$\delta$$ & \quad \mbox{if $\textbf{y}^{mis}$}\\
 \textbf{y}^{obs} \\ \end{array} \right. \]
\[\textbf{X}^{imp} = \left\{
\begin{array}{l l}
 $$\gamma$$ & \quad \mbox{if $\textbf{X}^{mis}$}\\
 \textbf{X}^{obs} \\ \end{array} \right. \]
$$\alpha_{j,l} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1), \quad l=1,\dots,(J-1)$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\gamma_m \sim \mathcal{N}(0, 1000), \quad m=1,\dots,M$$
$$\delta_p \sim \mathcal{N}(0, 1000), \quad p=1,\dots,P$$
$$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,J$$
\subsection{Data}
\code{N <- 100 \\
J <- 5 \\
X <- matrix(runif(N*J,-2,2),N,J); X[,1] <- 1 \#Design matrix X \\
M <- matrix(round(runif(N*J)-0.45),N,J); M[,1] <- 0 \#Missing indicators \\
X <- ifelse(M == 1, NA, X) \#Simulated X gets missings according to M \\
beta.orig <- runif(J,-2,2) \\
y <- as.vector(tcrossprod(X, t(beta.orig)) + rnorm(N,0,0.1)) \\
y[sample(1:N, round(N*.05))] <- NA \\
m <- ifelse(is.na(y), 1, 0) \#Missing indicator for vector y \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=matrix(0,J-1,J-1), \\
\hspace*{0.27 in} beta=rep(0,J), \\
\hspace*{0.27 in} gamma=rep(0,sum(is.na(X))), \\
\hspace*{0.27 in} delta=rep(0,sum(is.na(y))), \\
\hspace*{0.27 in} sigma=rep(0,J))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
pos.delta <- grep("delta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm((Data$J-1)*(Data$J-1)) \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} gamma <- rnorm(sum(is.na(Data$X))) \\
\hspace*{0.27 in} delta <- rnorm(sum(is.na(Data$y)), mean(Data$y, na.rm=TRUE), 1) \\
\hspace*{0.27 in} sigma <- runif(Data$J) \\
\hspace*{0.27 in} return(c(alpha, beta, gamma, delta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, N=N, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\
\hspace*{0.27 in} pos.gamma=pos.gamma, pos.delta=pos.delta, pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- matrix(parm[Data$pos.alpha], Data$J-1, Data$J-1) \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\
\hspace*{0.27 in} delta <- parm[Data$pos.delta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} delta.prior <- sum(dnormv(delta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- X.imputed <- Data$X \\
\hspace*{0.27 in} X.imputed[which(is.na(X.imputed))] <- gamma \\
\hspace*{0.27 in} y.imputed <- Data$y \\
\hspace*{0.27 in} y.imputed[which(is.na(y.imputed))] <- delta \\
\hspace*{0.27 in} for (j in 2:Data$J) \{mu[,j] <- tcrossprod(X.imputed[,-j], \\
\hspace*{0.62 in} t(alpha[,(j-1)]))\} \\
\hspace*{0.27 in} nu <- tcrossprod(X.imputed, t(beta)) \\
\hspace*{0.27 in} LL <- sum(dnorm(X.imputed[,-1], mu[,-1], \\
\hspace*{0.62 in} matrix(sigma[1:(Data$J-1)], Data$N, Data$J-1), log=TRUE), \\
\hspace*{0.62 in} dnorm(y.imputed, nu, sigma[Data$J], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + delta.prior + \\
\hspace*{0.62 in} sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(nu), nu, sigma[Data$J]), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \}
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0, (J-1)\textasciicircum 2), rep(0,J), rep(0, sum(is.na(X))), \\
\hspace*{0.27 in} rep(0, sum(is.na(y))), rep(1,J))}

\section{Linear Regression with Missing Response} \label{linear.reg.miss.resp}
This is an introductory example to missing values using data augmentation with auxiliary variables. The dependent variable, or response, has both observed values, $\textbf{y}^{obs}$, and missing values, $\textbf{y}^{mis}$. The $\alpha$ vector is for missing value imputation, and enables the use of the full-likelihood by augmenting te state with these auxiliary variables. In the model form, $M$ is used to denote the number of missing values, though it is used as an indicator in the data.
\subsection{Form}
$$\textbf{y}^{imp} \sim \mathcal{N}(\mu, \sigma^2)$$
\[\textbf{y}^{imp} = \left\{
\begin{array}{l l}
 $$\alpha$$ & \quad \mbox{if $\textbf{y}^{mis}$}\\
 \textbf{y}^{obs} \\ \end{array} \right. \]
$$\mu = \textbf{X}\beta$$
$$\alpha_m \sim \mathcal{N}(0, 1000), \quad m=1,\dots,M$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonsnacks) \\
N <- nrow(demonsnacks) \\
J <- ncol(demonsnacks) \\
y <- log(demonsnacks$Calories) \\
y[sample(1:N, round(N*0.05))] <- NA \\
M <- ifelse(is.na(y), 1, 0) \\
X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=rep(0,sum(M)), beta=rep(0,J), \\
\hspace*{0.27 in} sigma=0)) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(sum(Data$M), mean(y, na.rm=TRUE), 1) \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(alpha, beta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, M=M, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\
\hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dgamma(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} y.imputed <- Data$y \\
\hspace*{0.27 in} y.imputed[which(is.na(Data$y))] <- alpha \\
\hspace*{0.27 in} LL <- sum(dnorm(y.imputed, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,sum(M)), rep(0,J), 1)}

\section{Linear Regression with Missing Response via ABB} \label{linear.reg.miss.resp.abb}
The Approximate Bayesian Bootstrap (ABB), using the \code{ABB} function, is used to impute missing values in the dependent variable (DV), or response, given a propensity score. In this example, vector $\alpha$ is used to estimate propensity score $\eta$, while vector $\beta$ is for regression effects, and vector $\gamma$ has the monitored missing values. For more information on ABB, see the \code{ABB} function.
\subsection{Form}
$$\textbf{y}^{imp} \sim \mathcal{N}(\mu, \sigma^2)$$
\[\textbf{y}^{imp} = \left\{
\begin{array}{l l}
 $$\gamma$$ & \quad \mbox{if $\textbf{y}^{mis}$}\\
 \textbf{y}^{obs} \\ \end{array} \right. \]
$$\mu = \textbf{X}\beta$$
$$\gamma \sim p(\textbf{y}^{obs} | \textbf{y}^{obs}, \textbf{y}^{mis}, \eta)$$
$$\eta = \frac{1}{1 + \exp(-\nu)}$$
$$\nu = \textbf{X} \alpha$$
$$\alpha_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonsnacks) \\
N <- nrow(demonsnacks) \\
J <- ncol(demonsnacks) \\
y <- log(demonsnacks$Calories) \\
y[sample(1:N, round(N*0.05))] <- NA \\
M <- ifelse(is.na(y), 1, 0) \\
X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
mon.names <- c("LP",paste("gamma[",1:sum(is.na(y)),"]",sep="")) \\
parm.names <- as.parm.names(list(alpha=rep(0,J), beta=rep(0,J), sigma=0)) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(Data$J) \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(alpha, beta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, M=M, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\
\hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dgamma(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} y.imputed <- Data$y \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} nu <- as.vector(tcrossprod(Data$X, t(alpha))) \\
\hspace*{0.27 in} eta <- invlogit(nu) \\
\hspace*{0.27 in} breaks <- as.vector(quantile(eta, probs=c(0,0.2,0.4,0.6,0.8,1))) \\
\hspace*{0.27 in} B <- matrix(breaks[-length(breaks)], length(Data$y), 5, byrow=TRUE) \\
\hspace*{0.27 in} z <- rowSums(eta >= B) \\
\hspace*{0.27 in} for (i in 1:5) \{ \\
\hspace*{0.62 in} if(any(is.na(Data$y[which(z == i)]))) \{ \\
\hspace*{0.95 in} imp <- unlist(ABB(Data$y[which(z == i)])) \\
\hspace*{0.95 in} y.imputed[which(\{z == i\} \& is.na(Data$y))] <- imp\}\} \\
\hspace*{0.27 in} gamma <- y.imputed[which(is.na(Data$y))] \\
\hspace*{0.27 in} LL <- sum(dbern(Data$M, eta, log=TRUE), \\
\hspace*{0.62 in} dnorm(y.imputed, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,gamma), \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), rep(0,J), 1)}

\section{Linear Regression with Power Priors} \label{linear.reg.pp}
Power priors \citep{ibrahim00} are a class of informative priors when relevant historical data is available. Power priors may be used when it is desirable to take historical data into account while analyzing similar, current data. Both the current data, $\textbf{y}$ and $\textbf{X}$, and historical data, $\textbf{y}_h$ and $\textbf{X}_h$, are included in the power prior analysis, where $h$ indicates historical data. Each data set receives its own likelihood function, though the likelihood of the historical data is raised to an exponential power, $\alpha \in [0,1]$. In this example, $\alpha$ is a constant.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\textbf{y}_h \sim \mathcal{N}(\mu_h, \sigma^2)^\alpha$$
$$\mu = \textbf{X}\beta$$
$$\mu_h = \textbf{X}_h\beta$$
$$\alpha = 0.5$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{N <- 100 \\
J <- 5 \#Number of predictors, including the intercept \\
X <- Xh <- matrix(1,N,J) \\
for (j in 2:J) \{ \\
\hspace*{0.27 in} X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1)) \\
\hspace*{0.27 in} Xh[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\
beta.orig <- runif(J,-3,3) \\
e <- rnorm(N,0,0.1) \\
yh <- as.vector(tcrossprod(beta.orig, Xh) + e) \\
y <- as.vector(tcrossprod(beta.orig, X) + e) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(beta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(alpha=0.5, J=J, PGF=PGF, X=X, Xh=Xh, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y, \\
\hspace*{0.27 in} yh=yh) \\
} \\
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} muh <- tcrossprod(Data$Xh, t(beta)) \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} LL <- sum(Data$alpha*dnorm(Data$yh, muh, sigma, log=TRUE) + \\
\hspace*{0.62 in} dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 1)}

\section{Linear Regression with Zellner's g-Prior} \label{linear.reg.g}
For more information on Zellner's g-prior, see the documentation for the \code{dzellner} function.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu = \textbf{X}\beta$$
$$\beta \sim \mathcal{N}_J(0, g \sigma^2 (\textbf{X}^T \textbf{X})^{-1})$$
$$g \sim \mathcal{HG}(\alpha), \quad \alpha = 3$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonsnacks) \\
y <- log(demonsnacks$Calories) \\
X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\
J <- ncol(X) \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), g0=0, sigma=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.g <- grep("g0", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} g0 <- runif(1) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(beta, g0, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.g=pos.g, 
\hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} parm[Data$pos.g] <- g <- interval(parm[Data$pos.g], 1e-100, Inf) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Hyperprior \\
\hspace*{0.27 in} g.prior <- dhyperg(g, alpha=3, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- dzellner(beta, g, sigma, Data$X, log=TRUE) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + g.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \}
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(1,J), rep(1,2))}

\section{LSTAR} \label{lstar}
This is a Logistic Smooth-Threshold Autoregression (LSTAR), and is specified with a transition function that includes $\gamma$ as the shape parameter, $\textbf{y}$ as the transition variable, $\theta$ as the location parameter, and $d$ as the delay parameter.
\subsection{Form}
$$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2), \quad t=1,\dots,T$$
$$\mu_t = \pi_t (\alpha_1 + \phi_1 \textbf{y}_{t-1}) + (1 - \pi_t) (\alpha_2 + \phi_2 \textbf{y}_{t-1}), \quad t=2,\dots,T$$
$$\pi_t = \frac{1}{1 + \exp(-(\gamma (\textbf{y}_{t-d} - \theta)))}$$
$$\alpha_j \sim \mathcal{N}(0, 1000) \in [\textbf{y}_{min}, \textbf{y}_{max}], \quad j=1,\dots,2$$
$$\frac{\phi_j+1}{2} \sim \mathcal{BETA}(1, 1), \quad j=1,\dots,2$$
$$\gamma \sim \mathcal{HC}(25)$$
$$\theta \sim \mathcal{U}(\textbf{y}_{min}, \textbf{y}_{max})$$
$$\pi_1 \sim \mathcal{U}(0.001, 0.999)$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonfx) \\
y <- as.vector((log(as.matrix(demonfx[,1])))) \\
T <- length(y) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=rep(0,2), phi=rep(0,2), gamma=0, \\
\hspace*{0.27 in} theta=0, pi=0, sigma=0)) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
pos.theta <- grep("theta", parm.names) \\
pos.pi <- grep("pi", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- runif(2,min(Data$y),max(Data$y)) \\
\hspace*{0.27 in} phi <- runif(2, -1, 1) \\
\hspace*{0.27 in} gamma <- runif(1) \\
\hspace*{0.27 in} theta <- runif(1,min(Data$y),max(Data$y)) \\
\hspace*{0.27 in} pi <- runif(1, 0.001, 0.999) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(alpha, phi, gamma, theta, pi, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(PGF=PGF, T=T, mon.names=mon.names, parm.names=parm.names, \\
\hspace*{0.27 in} pos.alpha=pos.alpha, pos.phi=pos.phi, pos.gamma=pos.gamma, \\
\hspace*{0.27 in} pos.theta=pos.theta, pos.pi=pos.pi, pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- interval(parm[Data$pos.alpha], min(Data$y), max(Data$y)) \\
\hspace*{0.27 in} parm[Data$pos.alpha] <- alpha \\
\hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], -1, 1) \\
\hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.gamma] <- gamma \\
\hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], min(Data$y), max(Data$y)) \\
\hspace*{0.27 in} parm[Data$pos.theta] <- theta \\
\hspace*{0.27 in} parm[Data$pos.pi] <- pi <- interval(parm[Data$pos.pi], 0.001, 0.999) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} phi.prior <- sum(dbeta((phi+1)/2, 1, 1, log=TRUE)) \\
\hspace*{0.27 in} gamma.prior <- dhalfcauchy(gamma, 25, log=TRUE) \\
\hspace*{0.27 in} theta.prior <- dunif(theta, min(Data$y), max(Data$y), log=TRUE) \\
\hspace*{0.27 in} pi.prior <- dunif(pi, 0.001, 0.999, log=TRUE) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} pi <- c(pi, 1 / (1 + exp(-(gamma*(Data$y[-Data$T]-theta))))) \\
\hspace*{0.27 in} mu <- pi * c(alpha[1], alpha[1] + phi[1]*Data$y[-Data$T]) + \\
\hspace*{0.62 in} (1-pi) * c(alpha[2], alpha[2] + phi[2]*Data$y[-Data$T]) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y[-1], mu[-1], sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + gamma.prior + theta.prior + \\
\hspace*{0.62 in} pi.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(mean(y),2), rep(0.5,2), 1, mean(y), 0.5, 1)}

\section{MANCOVA} \label{mancova}
Since this is a multivariate extension of ANCOVA, please see the ANCOVA example in section \ref{ancova} for a univariate introduction.
\subsection{Form}
$$\textbf{Y}_{i,1:J} \sim \mathcal{N}_K(\mu_{i,1:J}, \Sigma), \quad i=1,\dots,N$$
$$\mu_{i,k} = \alpha_k + \beta_{k,\textbf{X}[i,1]} + \gamma_{k,\textbf{X}[i,1]} + \textbf{X}_{1:N,3:(C+J)} \delta_{k,1:C}$$
$$\epsilon_{i,k} = \textbf{Y}_{i,k} - \mu_{i,k}$$
$$\alpha_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$
$$\beta_{k,l} \sim \mathcal{N}(0, \sigma^2_1), \quad l=1,\dots,(L-1)$$
$$\beta_{1:K,L} = - \sum^{L-1}_{l=1} \beta_{1:K,l}$$
$$\gamma_{k,m} \sim \mathcal{N}(0, \sigma^2_2), \quad m=1,\dots,(M-1)$$
$$\gamma_{1:K,M} = - \sum^{M-1}_{m=1} \beta_{1:K,m}$$
$$\delta_{k,c} \sim \mathcal{N}(0, 1000)$$
$$\Omega \sim \mathcal{W}_{K+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_K$$
$$\Sigma = \Omega^{-1}$$
$$\sigma_{1:J} \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{C <- 2 \#Number of covariates \\
J <- 2 \#Number of factors (treatments) \\
K <- 3 \#Number of endogenous (dependent) variables \\
L <- 4 \#Number of levels in factor (treatment) 1 \\
M <- 5 \#Number of levels in factor (treatment) 2 \\
N <- 100 \\
X <- matrix(c(rcat(N, rep(1/L,L)), rcat(N, rep(1/M,M)), \\
\hspace*{0.27 in} runif(N*C,0,1)), N, J + C) \\
alpha <- runif(K,-1,1) \\
beta <- matrix(runif(K*L,-2,2), K, L) \\
beta[,L] <- -rowSums(beta[,-L]) \\
gamma <- matrix(runif(K*M,-2,2), K, M) \\
gamma[,M] <- -rowSums(gamma[,-M]) \\
delta <- matrix(runif(K*C), K, C) \\
Y <- matrix(NA,N,K) \\
for (k in 1:K) \{ \\
\hspace*{0.27 in} Y[,k] <- alpha[k] + beta[k,X[,1]] + gamma[k,X[,2]] + \\
\hspace*{0.27 in} tcrossprod(delta[k,], X[,-c(1,2)]) + rnorm(1,0,0.1)\} \\
S <- diag(K) \\
mon.names <- c("LP", "s.o.beta", "s.o.gamma", "s.o.epsilon", \\
\hspace*{0.27 in} as.parm.names(list(s.beta=rep(0,K), s.gamma=rep(0,K), \\
\hspace*{0.27 in} s.epsilon=rep(0,K)))) \\
parm.names <- as.parm.names(list(alpha=rep(0,K), beta=matrix(0,K,(L-1)), \\
\hspace*{0.27 in} gamma=matrix(0,K,(M-1)), delta=matrix(0,K,C), U=diag(K), \\
\hspace*{0.27 in} sigma=rep(0,2)), uppertri=c(0,0,0,0,1,0)) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
pos.delta <- grep("delta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(Data$K) \\
\hspace*{0.27 in} sigma <- runif(2) \\
\hspace*{0.27 in} beta <- rnorm(Data$K*(Data$L-1), 0, sigma[1]) \\
\hspace*{0.27 in} gamma <- rnorm(Data$K*(Data$M-1), 0, sigma[2]) \\
\hspace*{0.27 in} delta <- rnorm(Data$K*Data$C) \\
\hspace*{0.27 in} U <- rwishartc(Data$K+1, Data$S) \\
\hspace*{0.27 in} return(c(alpha, beta, gamma, delta, U[upper.tri(U, diag=TRUE)], \\
\hspace*{0.62 in} sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(C=C, J=J, K=K, L=L, M=M, N=N, PGF=PGF, S=S, X=X, Y=Y, \\
\hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\
\hspace*{0.27 in} pos.beta=pos.beta, pos.gamma=pos.gamma, pos.delta=pos.delta, \\
\hspace*{0.27 in} pos.sigma=pos.sigma) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} beta <- matrix(c(parm[Data$pos.beta], rep(0,Data$K)), Data$K, Data$L) \\
\hspace*{0.27 in} beta[,Data$L] <- -rowSums(beta[,-Data$L]) \\
\hspace*{0.27 in} gamma <- matrix(c(parm[Data$[pos.gamma], \\
\hspace*{0.62 in} rep(0,Data$K)), Data$K, Data$M) \\
\hspace*{0.27 in} gamma[,Data$M] <- -rowSums(gamma[,-Data$M]) \\
\hspace*{0.27 in} delta <- matrix(parm[Data$pos.delta], Data$K, Data$C) \\
\hspace*{0.27 in} U <- as.parm.matrix(U, Data$K, parm, Data, chol=TRUE) \\
\hspace*{0.27 in} diag(U) <- exp(diag(U)) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, sigma[1], log=TRUE)) \\
\hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, sigma[2], log=TRUE)) \\
\hspace*{0.27 in} delta.prior <- sum(dnormv(delta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} U.prior <- dwishartc(U, Data$K+1, Data$S, log=TRUE) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- matrix(0,Data$N,Data$K) \\
\hspace*{0.27 in} for (k in 1:Data$K) \{ \\
\hspace*{0.62 in} mu[,k] <- alpha[k] + beta[k,Data$X[,1]] + gamma[k,Data$X[,2]] + \\
\hspace*{0.62 in} tcrossprod(Data$X[,-c(1,2)], t(delta[k,]))\} \\
\hspace*{0.27 in} LL <- sum(dmvnpc(Data$Y, mu, U, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Variance Components, Omnibus \\
\hspace*{0.27 in} s.o.beta <- sd(as.vector(beta)) \\
\hspace*{0.27 in} s.o.gamma <- sd(as.vector(gamma)) \\
\hspace*{0.27 in} s.o.epsilon <- sd(as.vector(Data$Y - mu)) \\
\hspace*{0.27 in} \#\#\# Variance Components, Univariate \\
\hspace*{0.27 in} s.beta <- sqrt(.rowVars(beta)) \\
\hspace*{0.27 in} s.gamma <- sqrt(.rowVars(gamma)) \\
\hspace*{0.27 in} s.epsilon <- sqrt(.colVars(Data$Y - mu)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + delta.prior + \\
\hspace*{0.62 in} U.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, s.o.beta, s.o.gamma, \\
\hspace*{0.62 in} s.o.epsilon, s.beta, s.gamma, s.epsilon), \\
\hspace*{0.62 in} yhat=rmvnpc(nrow(mu), mu, U), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,K), rep(0,K*(L-1)), rep(0,K*(M-1)), \\
\hspace*{0.27 in} rep(0,C*K), upper.triangle(S, diag=TRUE), rep(1,2))}

\section{MANOVA} \label{manova}
Since this is a multivariate extension of ANOVA, please see the two-way ANOVA example in section \ref{anova.two.way} for a univariate introduction.
\subsection{Form}
$$\textbf{Y}_{i,1:J} \sim \mathcal{N}_K(\mu_{i,1:J}, \Omega^{-1}), \quad i=1,\dots,N$$
$$\mu_{i,k} = \alpha_k + \beta_{k,\textbf{X}[i,1]} + \gamma_{k,\textbf{X}[i,1]}$$
$$\epsilon_{i,k} = \textbf{Y}_{i,k} - \mu_{i,k}$$
$$\alpha_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$
$$\beta_{k,l} \sim \mathcal{N}(0, \sigma^2_1), \quad l=1,\dots,(L-1)$$
$$\beta_{1:K,L} = - \sum^{L-1}_{l=1} \beta_{1:K,l}$$
$$\gamma_{k,m} \sim \mathcal{N}(0, \sigma^2_2), \quad m=1,\dots,(M-1)$$
$$\gamma_{1:K,M} = - \sum^{M-1}_{m=1} \beta_{1:K,m}$$
$$\Omega \sim \mathcal{W}_{K+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_K$$
$$\sigma_{1:J} \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{J <- 2 \#Number of factors (treatments) \\
K <- 3 \#Number of endogenous (dependent) variables \\
L <- 4 \#Number of levels in factor (treatment) 1 \\
M <- 5 \#Number of levels in factor (treatment) 2 \\
N <- 100 \\
X <- cbind(rcat(N, rep(1/L,L)), rcat(N, rep(1/M,M))) \\
alpha <- runif(K,-1,1) \\
beta <- matrix(runif(K*L,-2,2), K, L) \\
beta[,L] <- -rowSums(beta[,-L]) \\
gamma <- matrix(runif(K*M,-2,2), K, M) \\
gamma[,M] <- -rowSums(gamma[,-M]) \\
Y <- matrix(NA,N,K) \\
for (k in 1:K) \{ \\
\hspace*{0.27 in} Y[,k] <- alpha[k] + beta[k,X[,1]] + gamma[k,X[,2]] + rnorm(1,0,0.1)\} \\
S <- diag(K) \\
mon.names <- c("LP", "s.o.beta", "s.o.gamma", "s.o.epsilon", \\
\hspace*{0.27 in} as.parm.names(list(s.beta=rep(0,K), s.gamma=rep(0,K), \\
\hspace*{0.27 in} s.epsilon=rep(0,K)))) \\
parm.names <- as.parm.names(list(alpha=rep(0,K), beta=matrix(0,K,(L-1)), \\
\hspace*{0.27 in} gamma=matrix(0,K,(M-1)), U=diag(K), sigma=rep(0,2)), \\
\hspace*{0.27 in} uppertri=c(0,0,0,1,0)) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(Data$K) \\
\hspace*{0.27 in} sigma <- runif(2) \\
\hspace*{0.27 in} beta <- rnorm(Data$K*(Data$L-1), 0, sigma[1]) \\
\hspace*{0.27 in} gamma <- rnorm(Data$K*(Data$M-1), 0, sigma[2]) \\
\hspace*{0.27 in} U <- rwishartc(Data$K+1, Data$S) \\
\hspace*{0.27 in} return(c(alpha, beta, gamma, U[upper.tri(U, diag=TRUE)], sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, K=K, L=L, M=M, N=N, PGF=PGF, S=S, X=X, Y=Y, \\
\hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\
\hspace*{0.27 in} pos.beta=pos.beta, pos.gamma=pos.gamma, pos.sigma=pos.sigma) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} beta <- matrix(c(parm[Data$pos.beta], rep(0,Data$K)), \\
\hspace*{0.27 in} beta[,Data$L] <- -rowSums(beta[,-Data$L]) \\
\hspace*{0.27 in} gamma <- matrix(c(parm[Data$pos.gamma], \\
\hspace*{0.62 in} rep(0,Data$K)), Data$K, Data$M) \\
\hspace*{0.27 in} gamma[,Data$M] <- -rowSums(gamma[,-Data$M]) \\
\hspace*{0.27 in} U <- as.parm.matrix(U, Data$K, parm, Data, chol=TRUE) \\
\hspace*{0.27 in} diag(U) <- exp(diag(U)) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, sigma[1], log=TRUE)) \\
\hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, sigma[2], log=TRUE)) \\
\hspace*{0.27 in} U.prior <- dwishartc(U, Data$K+1, Data$S, log=TRUE) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- matrix(0,Data$N,Data$K) \\
\hspace*{0.27 in} for (k in 1:Data$K) \{ \\
\hspace*{0.62 in} mu[,k] <- alpha[k] + beta[k,Data$X[,1]] + gamma[k,Data$X[,2]]\} \\
\hspace*{0.27 in} LL <- sum(dmvnpc(Data$Y, mu, U, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Variance Components, Omnibus \\
\hspace*{0.27 in} s.o.beta <- sd(as.vector(beta)) \\
\hspace*{0.27 in} s.o.gamma <- sd(as.vector(gamma)) \\
\hspace*{0.27 in} s.o.epsilon <- sd(as.vector(Data$Y - mu)) \\
\hspace*{0.27 in} \#\#\# Variance Components, Univariate \\
\hspace*{0.27 in} s.beta <- sqrt(.rowVars(beta)) \\
\hspace*{0.27 in} s.gamma <- sqrt(.rowVars(gamma)) \\
\hspace*{0.27 in} s.epsilon <- sqrt(.colVars(Data$Y - mu)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + U.prior + \\
\hspace*{0.62 in} sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, s.o.beta, s.o.gamma, \\
\hspace*{0.62 in} s.o.epsilon, s.beta, s.gamma, s.epsilon), \\
\hspace*{0.62 in} yhat=rmvnpc(nrow(mu), mu, U), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,K), rep(0,K*(L-1)), rep(0,K*(M-1)), \\
\hspace*{0.27 in} upper.triangle(S, diag=TRUE), rep(1,2))}

\section{Mixed Logit} \label{mixed.logit}
\subsection{Form}
$$\textbf{y}_i \sim \mathcal{CAT}(\textbf{p}_{i,1:J}), \quad i=1,\dots,N$$
$$\textbf{p}_{i,j} = \frac{\phi_{i,j}}{\sum^J_{j=1} \phi_{i,j}}$$
$$\phi = \exp(\mu)$$
$$\mu_{i,j} = \beta_{j,1:K,i} \textbf{X}_{i,1:K} \in [-700,700], \quad i=1,\dots,N, \quad j=1,\dots,(J-1)$$
$$\mu_{i,J} = 0$$
$$\beta_{j,k,i} \sim \mathcal{N}(\zeta^\mu_{j,k}, \zeta^\sigma2_{j,k}), \quad i=1,\dots,N, \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$
$$\zeta^\mu_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$
$$\zeta^\sigma_{j,k} \sim \mathcal{HC}{25}), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$
\subsection{Data}
\code{data(demonchoice) \\
y <- as.numeric(demonchoice[,1]) \\
X <- cbind(1, as.matrix(demonchoice[,2:3])) \\
for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\
N <- length(y) \\
J <- length(unique(y)) \#Number of categories in y \\
K <- ncol(X) \#Number of predictors (including the intercept) \\
S <- diag(J-1) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=array(0, dim=c(J-1,K,N)), \\
\hspace*{0.27 in} zeta.mu=matrix(0,J-1,K), zeta.sigma=matrix(0,J-1,K))) \\
pos.beta <- grep("beta", parm.names) \\
pos.zeta.mu <- grep("zeta.mu", parm.names) \\
pos.zeta.sigma <- grep("zeta.sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} zeta.mu <- matrix(rnorm((Data$J-1)*Data$K), Data$J-1, Data$K) \\
\hspace*{0.27 in} zeta.sigma <- matrix(runif((Data$J-1)*Data$K), Data$J-1, Data$K) \\
\hspace*{0.27 in} beta <- array(rnorm((Data$J-1)*Data$K*Data$N), \\
\hspace*{0.62 in} dim=c( Data$J-1, Data$K, Data$N)) \\
\hspace*{0.27 in} return(c(beta, as.vector(zeta.mu), as.vector(zeta.sigma))) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, K=K, N=N, PGF=PGF, S=S, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.zeta.mu=pos.zeta.mu, \\
\hspace*{0.27 in} pos.zeta.sigma=pos.zeta.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- array(parm[Data$pos.beta], dim=c(Data$J-1, Data$K, Data$N)) \\
\hspace*{0.27 in} zeta.mu <- matrix(parm[Data$pos.zeta.mu], Data$J-1, Data$K) \\
\hspace*{0.27 in} zeta.sigma <- matrix(interval(parm[Data$pos.zeta.sigma], 1e-100, Inf), \\
\hspace*{0.62 in} Data$J-1, Data$K) \\
\hspace*{0.27 in} parm[Data$pos.zeta.sigma] <- as.vector(zeta.sigma) \\
\hspace*{0.27 in} \#\#\# Log-Hyperprior \\
\hspace*{0.27 in} zeta.mu.prior <- sum(dnormv(zeta.mu, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} zeta.sigma.prior <- sum(dhalfcauchy(zeta.sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnorm(beta, zeta.mu, zeta.sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- matrix(0, Data$N, Data$J) \\
\hspace*{0.27 in} for (j in 1:(Data$J-1)) mu[,j] <- rowSums(Data$X * t(beta[j, , ])) \\
\hspace*{0.27 in} mu <- interval(mu, -700, 700, reflect=FALSE) \\
\hspace*{0.27 in} phi <- exp(mu) \\
\hspace*{0.27 in} p <- phi / rowSums(phi) \\
\hspace*{0.27 in} LL <- sum(dcat(Data$y, p, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + zeta.mu.prior + zeta.sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(p), p), \\
\hspace*{0.62 in} parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,(J-1)*K*N), rep(0,(J-1)*K), rep(1,(J-1)*K))}

\section{Mixture Model, Finite} \label{fmm}
This finite mixture model (FMM) imposes a multilevel structure on each of the $J$ regression effects in $\beta$, so that mixture components share a common residual standard deviation, $\nu_m$. Identifiability is gained at the expense of some shrinkage. The record-level mixture membership parameter vector, $\theta$, is a vector of discrete parameters. Discrete parameters are not supported in all algorithms. The example below is updated with the Slice sampler.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu_i = \textbf{X}_{i,1:J}\beta_{\theta[i],1:J}, \quad i=1,\dots,N$$
$$\theta_i \sim \mathcal{CAT}(\pi_{1:M}), \quad i=1,\dots,N$$
$$\beta_{m,j} \sim \mathcal{N}(0, \nu^2_m), \quad j=1,\dots,J, \quad m=2,\dots,M$$
$$\beta_{1,j} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\nu_m \sim \mathcal{HC}(25), \quad m=1,\dots,M$$
$$\sigma \sim \mathcal{HC}(25)$$
$$\pi_{1:M} \sim \mathcal{D}(\alpha_{1:M})$$
$$\alpha_m = 1$$
\subsection{Data}
\code{data(demonsnacks) \\
y <- log(demonsnacks$Calories) \\
X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\
M <- 2 \#Number of mixtures \\
N <- length(y) \#Number of records \\
J <- ncol(X) \#Number of predictors, including the intercept \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
alpha <- rep(1,M) \#Prior probability of mixing probabilities \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(theta=rep(0,N), beta=matrix(0,M,J), \\
\hspace*{0.27 in} nu=rep(0,M), sigma=0)) \\
pos.theta <- grep("theta", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.nu <- grep("nu", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} theta <- rcat(Data$N, rep(1/Data$M, Data$M)) \\
\hspace*{0.27 in} nu <- runif(Data$M) \\
\hspace*{0.27 in} beta <- rnormv(Data$M*Data$J, 0, \\
\hspace*{0.62 in} cbind(1000, matrix(nu, Data$M, Data$J-1))) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(theta, beta, nu, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, M=M, N=N, PGF=PGF, X=X, alpha=alpha, \\
\hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.theta=pos.theta, \\
\hspace*{0.27 in} pos.beta=pos.beta, pos.nu=pos.nu, pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$M, Data$J) \\
\hspace*{0.27 in} theta <- parm[Data$pos.theta] \\
\hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\
\hspace*{0.27 in} pi <- rep(0, Data$M) \\
\hspace*{0.27 in} tab <- table(theta) \\
\hspace*{0.27 in} pi[as.numeric(names(tab))] <- as.vector(tab) \\
\hspace*{0.27 in} pi <- pi / sum(pi) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, \\
\hspace*{0.62 in} cbind(1000, matrix(nu, Data$M, Data$J-1)), log=TRUE)) \\
\hspace*{0.27 in} theta.prior <- sum(dcat(theta, p=pi, log=TRUE)) \\
\hspace*{0.27 in} pi.prior <- ddirichlet(pi, Data$alpha, log=TRUE) \\
\hspace*{0.27 in} nu.prior <- sum(dhalfcauchy(nu, 25, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- rowSums(beta[theta,] * Data$X) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + theta.prior + pi.prior + nu.prior + \\
\hspace*{0.62 in} sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rcat(N,rep(1/M,M)), rep(0,M*J), rep(1,M), 1)}

\section{Mixture Model, Infinite} \label{imm}
This infinite mixture model (IMM) uses a Dirichlet process via truncated stick-breaking. The record-level mixture membership parameter vector, $\theta$, is a vector of discrete parameters. Discrete parameters are not supported in all algorithms. The example below is updated with the Slice sampler.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu_i = \textbf{X}_{i,1:J}\beta_{\theta[i],1:J}, \quad i=1,\dots,N$$
$$\theta_i \sim \mathcal{CAT}(\pi_{1:M}), \quad i=1,\dots,N$$
$$\beta_{m,j} \sim \mathcal{N}(0, \nu^2_m), \quad j=1,\dots,J, \quad m=2,\dots,M$$
$$\beta_{1,j} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\nu_m \sim \mathcal{HC}(25), \quad m=1,\dots,M$$
$$\sigma \sim \mathcal{HC}(25)$$
$$\pi = \mathrm{Stick}(\delta)$$
$$\delta_m \sim \mathcal{BETA}(1, \gamma), m=1,\dots,(M-1)$$
$$\gamma \sim \mathcal{G}(\alpha, \iota)$$
$$\alpha \sim \mathcal{HC}(25)$$
$$\iota \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonsnacks) \\
y <- log(demonsnacks$Calories) \\
X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\
M <- 3 \#Maximum number of mixtures to explore \\
N <- length(y) \#Number of records \\
J <- ncol(X) \#Number of predictors, including the intercept \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
mon.names <- c("LP", as.parm.names(list(pi=rep(0,M)))) \\
parm.names <- as.parm.names(list(theta=rep(0,N), delta=rep(0,M-1), \\
\hspace*{0.27 in} beta=matrix(0,M,J), nu=rep(0,M), sigma=0, alpha=0, iota=0, gamma=0)) \\
pos.theta <- grep("theta", parm.names) \\
pos.delta <- grep("delta", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.nu <- grep("nu", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.iota <- grep("iota", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} nu <- runif(Data$M) \\
\hspace*{0.27 in} beta <- rnormv(Data$M*Data$J, 0, \\
\hspace*{0.62 in} cbind(1000, matrix(nu, Data$M, Data$J-1))) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} alpha <- runif(1) \\
\hspace*{0.27 in} iota <- runif(1) \\
\hspace*{0.27 in} gamma <- rgamma(1, alpha, iota) \\
\hspace*{0.27 in} delta <- rev(sort(rbeta(Data$M-1, 1, gamma))) \\
\hspace*{0.27 in} theta <- rcat(Data$N, Stick(delta)) \\
\hspace*{0.27 in} return(c(theta, delta, beta, nu, sigma, alpha, iota, gamma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, M=M, N=N, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.theta=pos.theta, pos.delta=pos.delta, \\
\hspace*{0.27 in} pos.beta=pos.beta, pos.nu=pos.nu, pos.sigma=pos.sigma, \\
\hspace*{0.27 in} pos.alpha=pos.alpha, pos.iota=pos.iota, pos.gamma=pos.gamma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Hyperhyperparameters \\
\hspace*{0.27 in} alpha <- interval(parm[Data$pos.alpha], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.alpha] <- alpha \\
\hspace*{0.27 in} iota <- interval(parm[Data$pos.iota], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.iota] <- iota \\
\hspace*{0.27 in} \#\#\# Hyperparameters \\
\hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], 1e-10, 1-1e-10) \\
\hspace*{0.27 in} parm[Data$pos.delta] <- delta \\
\hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.gamma] <- gamma \\
\hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$M, Data$J) \\
\hspace*{0.27 in} theta <- parm[Data$pos.theta] \\
\hspace*{0.27 in} pi <- Stick(delta) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Hyperhyperprior \\
\hspace*{0.27 in} alpha.prior <- dhalfcauchy(alpha, 25, log=TRUE) \\
\hspace*{0.27 in} iota.prior <- dhalfcauchy(iota, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Hyperprior \\
\hspace*{0.27 in} delta.prior <- dStick(delta, gamma, log=TRUE) \\
\hspace*{0.27 in} gamma.prior <- dgamma(gamma, alpha, iota, log=TRUE) \\
\hspace*{0.27 in} nu.prior <- sum(dhalfcauchy(nu, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, \\
\hspace*{0.62 in} cbind(1000, matrix(nu, Data$M, Data$J-1)), log=TRUE)) \\
\hspace*{0.27 in} theta.prior <- sum(dcat(theta, pi, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- rowSums(beta[theta,]*Data$X) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + delta.prior + theta.prior + nu.prior + \\
\hspace*{0.62 in} sigma.prior + alpha.prior + iota.prior + gamma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,pi), \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rcat(N, rev(sort(rStick(M-1,1)))), rep(0.5,M-1), \\
\hspace*{0.27 in} rep(0,M*J), rep(1,M), rep(1,4))}

\section{Multinomial Logit} \label{mnl}
\subsection{Form}
$$\textbf{y}_i \sim \mathcal{CAT}(\textbf{p}_{i,1:J}), \quad i=1,\dots,N$$
$$\textbf{p}_{i,j} = \frac{\phi_{i,j}}{\sum^J_{j=1} \phi_{i,j}}, \quad \sum^J_{j=1} \textbf{p}_{i,j} = 1$$
$$\phi = \exp(\mu)$$
$$\mu_{i,J} = 0, \quad i=1,\dots,N$$
$$\mu_{i,j} = \textbf{X}_{i,1:K} \beta_{j,1:K} \in [-700,700], \quad j=1,\dots,(J-1)$$
$$\beta_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$
\subsection{Data}
\code{data(demonchoice) \\
y <- as.numeric(demonchoice[,1]) \\
X <- cbind(1, as.matrix(demonchoice[,2:3])) \\
for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\
N <- length(y) \\
J <- length(unique(y)) \#Number of categories in y \\
K <- ncol(X) \#Number of predictors (including the intercept) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=matrix(0,J-1,K))) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm((Data$J-1)*Data$K) \\
\hspace*{0.27 in} return(beta) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- matrix(parm, Data$J-1, Data$K) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- matrix(0, Data$N, Data$J) \\
\hspace*{0.27 in} mu[,-Data$J] <- tcrossprod(Data$X, beta) \\
\hspace*{0.27 in} mu <- interval(mu, -700, 700, reflect=FALSE) \\
\hspace*{0.27 in} phi <- exp(mu) \\
\hspace*{0.27 in} p <- phi / rowSums(phi) \\
\hspace*{0.27 in} LL <- sum(dcat(Data$y, p, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(p), p), \\
\hspace*{0.62 in} parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,(J-1)*K))}

\section{Multinomial Logit, Nested} \label{nmnl}
\subsection{Form}
$$\textbf{y}_i \sim \mathcal{CAT}(\textbf{P}_{i,1:J}), \quad i=1,\dots,N$$
$$\textbf{P}_{1:N,1} = \frac{\textbf{R}}{\textbf{R} + \exp(\alpha \textbf{I})}$$
$$\textbf{P}_{1:N,2} = \frac{(1 - \textbf{P}_{1:N,1}) \textbf{S}_{1:N,1}}{\textbf{V}}$$
$$\textbf{P}_{1:N,3} = \frac{(1 - \textbf{P}_{1:N,1}) \textbf{S}_{1:N,2}}{\textbf{V}}$$
$$\textbf{R}_{1:N} = \exp(\mu_{1:N,1})$$
$$\textbf{S}_{1:N,1:2} = \exp(\mu_{1:N,2:3})$$
$$\textbf{I} = \log(\textbf{V})$$
$$\textbf{V}_i = \displaystyle\sum^K_{k=1} \textbf{S}_{i,k}, \quad i=1,\dots,N$$
$$\mu_{1:N,1} = \textbf{X} \iota \in [-700,700]$$
$$\mu_{1:N,2} = \textbf{X} \beta_{2,1:K} \in [-700,700]$$
$$\iota = \alpha \beta_{1,1:K}$$
$$\alpha \sim \mathcal{EXP}(1) \in [0,2]$$
$$\beta_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1) \quad k=1,\dots,K$$
where there are $J=3$ categories of $\textbf{y}$, $K=3$ predictors, $\textbf{R}$ is the non-nested alternative, $\textbf{S}$ is the nested alternative, $\textbf{V}$ is the observed utility in the nest, $\alpha$ is effectively 1 - correlation and has a truncated exponential distribution, and $\iota$ is a vector of regression effects for the isolated alternative after $\alpha$ is taken into account. The third alternative is the reference category.
\subsection{Data}
\code{data(demonchoice) \\
y <- as.numeric(demonchoice[,1]) \\
X <- cbind(1, as.matrix(demonchoice[,2:3])) \\
for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\
N <- length(y) \\
J <- length(unique(y)) \#Number of categories in y \\
K <- ncol(X) \#Number of predictors (including the intercept) \\
mon.names <- c("LP", as.parm.names(list(iota=rep(0,K)))) \\
parm.names <- as.parm.names(list(alpha=0, beta=matrix(0,J-1,K))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rtrunc(1, "exp", a=0, b=2, rate=1) \\
\hspace*{0.27 in} beta <- rnorm((Data$J-1)*Data$K) \\
\hspace*{0.27 in} return(c(alpha, beta)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, y=y)
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Hyperparameters \\
\hspace*{0.27 in} alpha.rate <- 1 \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} parm[Data$pos.alpha] <- alpha <- interval(parm[Data$pos.alpha],0,2) \\
\hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J-1, Data$K) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dtrunc(alpha, "exp", a=0, b=2, rate=alpha.rate, \\
\hspace*{0.62 in} log=TRUE) \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- P <- matrix(0, Data$N, Data$J) \\
\hspace*{0.27 in} iota <- alpha * beta[1,] \\
\hspace*{0.27 in} mu[,1] <- tcrossprod(Data$X, t(iota)) \\
\hspace*{0.27 in} mu[,2] <- tcrossprod(Data$X, t(beta[2,])) \\
\hspace*{0.27 in} mu <- interval(mu, -700, 700, reflect=FALSE) \\
\hspace*{0.27 in} R <- exp(mu[,1]) \\
\hspace*{0.27 in} S <- exp(mu[,-1]) \\
\hspace*{0.27 in} V <- rowSums(S) \\
\hspace*{0.27 in} I <- log(V) \\
\hspace*{0.27 in} P[,1] <- R / (R + exp(alpha*I)) \\
\hspace*{0.27 in} P[,2] <- (1 - P[,1]) * S[,1] / V \\
\hspace*{0.27 in} P[,3] <- (1 - P[,1]) * S[,2] / V \\
\hspace*{0.27 in} LL <- sum(dcat(Data$y, P, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,iota), \\
\hspace*{0.62 in} yhat=rcat(nrow(P), P), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(0.5, rep(0.1,(J-1)*K))}

\section{Multinomial Probit} \label{mnp}
\subsection{Form}
$$\textbf{W}_{i,1:(J-1)} \sim \mathcal{N}_{J-1}(\mu_{i,1:(J-1)}, \Sigma), \quad i=1,\dots,N$$
\[\textbf{W}_{i,j} \in \left\{
\begin{array}{l l}
 $[0,10]$ & \quad \mbox{if $\textbf{y}_i = j$}\\
 $[-10,0]$ \\ \end{array} \right. \]
$$\mu_{1:N,j} = \textbf{X} \beta_{j,1:K}$$
$$\Sigma = \textbf{U}^T \textbf{U}$$
$$\beta_{j,k} \sim \mathcal{N}(0, 10), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$
$$\textbf{U}_{j,k} \sim \mathcal{N}(0,1), \quad j=1,\dots,(J-1), \quad k=1,\dots,(J-1), \quad j \ge k, \quad j \ne k = 1$$
\subsection{Data}
\code{data(demonchoice) \\
y <- as.numeric(demonchoice[,1]) \\
X <- cbind(1, as.matrix(demonchoice[,2:3])) \\
for (j in 2:ncol(X)) X[,j] <- CenterScale(X[,j]) \\
N <- length(y) \\
J <- length(unique(y)) \#Number of categories in y \\
K <- ncol(X) \#Number of predictors (including the intercept) \\
S <- diag(J-1) \\
U <- matrix(NA,J-1,J-1)  \\
U[upper.tri(U, diag=TRUE)] <- 0 \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=matrix(0,(J-1),K), \\
\hspace*{0.27 in} U=U, W=matrix(0,N,J-1))) \\
parm.names <- parm.names[-which(parm.names == "U[1,1]")] \\
pos.beta <- grep("beta", parm.names) \\
pos.U <- grep("U", parm.names) \\
pos.W <- grep("W", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm((Data$J-1)*Data$K) \\
\hspace*{0.27 in} U <- rnorm((Data$J-2) + (factorial(Data$J-1) / \\
\hspace*{0.62 in} (factorial(Data$J-1-2)*factorial(2)))) \\
\hspace*{0.27 in} W <- matrix(runif(Data$N*(Data$J-1),-10,0), Data$N, Data$J-1) \\
\hspace*{0.27 in} Y <- as.indicator.matrix(Data$y) \\
\hspace*{0.27 in} W <- ifelse(Y[,-Data$J] == 1, abs(W), W) \\
\hspace*{0.27 in} return(c(beta, U, as.vector(W)))\} \\
MyData <- list(J=J, K=K, N=N, PGF=PGF, S=S, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.U=pos.U, pos.W=pos.W, \\
\hspace*{0.27 in} y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J-1, Data$K) \\
\hspace*{0.27 in} u <- c(0, parm[Data$pos.U]) \\
\hspace*{0.27 in} U <- diag(Data$J-1) \\
\hspace*{0.27 in} U[upper.tri(U, diag=TRUE)] <- u \\
\hspace*{0.27 in} diag(U) <- exp(diag(U)) \\
\hspace*{0.27 in} Sigma <- t(U) \%*\% U \\
\hspace*{0.27 in} Sigma[1,] <- Sigma[,1] <- U[1,] \\
\hspace*{0.27 in} W <- matrix(parm[Data$pos.W], Data$N, Data$J-1) \\
\hspace*{0.27 in} Y <- as.indicator.matrix(Data$y) \\
\hspace*{0.27 in} temp <- which(Y[,-c(Data$J)] == 1) \\
\hspace*{0.27 in} W[temp] <- interval(W[temp], 0, 10) \\
\hspace*{0.27 in} temp <- which(Y[,-c(Data$J)] == 0) \\
\hspace*{0.27 in} W[temp] <- interval(W[temp], -10, 0) \\
\hspace*{0.27 in} parm[Data$pos.W] <- as.vector(W) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 10, log=TRUE)) \\
\hspace*{0.27 in} U.prior <- sum(dnorm(u[-1], 0, 1, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) \\
\hspace*{0.27 in} \#eta <- exp(cbind(mu,0)) \\
\hspace*{0.27 in} \#p <- eta / rowSums(eta) \\
\hspace*{0.27 in} LL <- sum(dmvn(W, mu, Sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + U.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=max.col(cbind(rmvn(nrow(mu), mu, Sigma),0)), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- GIV(Model, MyData, PGF=TRUE)}

\section{Multiple Discrete-Continuous Choice} \label{mdcc}
This form of a multivariate discrete-continuous choice model was introduced in \citet{kim02} and referred to as a variety model. The original version is presented with log-normally distributed errors, but a gamma regression form is used here instead, which has always mixed better in testing. Note that the $\gamma$ parameters are fixed here, as recommended for identifiability in future articles by these authors.
\subsection{Form}
$$\textbf{Y} \sim \mathcal{G}(\lambda\tau, \tau)$$
$$\lambda_{i,j} = \exp(\textbf{Z}_{i,j}\log(\psi1_{m[i],j}) + \textbf{X1}_{i,1:K}\log(\beta) + \textbf{X2}_{i,1:L}\log(\delta))(\textbf{Y}_{i,j} + \gamma_j)^\alpha_j), \quad i=1,\dots,N, j=1,\dots,J$$
$$\alpha_j \sim \mathcal{U}(0,1), \quad j=1,\dots,J$$
$$\log(\beta_k) \sim \mathcal{N}(0,1000), \quad k=1,\dots,K$$
$$\gamma_j = 1, \quad j=1,\dots,J$$
$$\log(\delta_{j,l}) \sim \mathcal{N}(0,1000), \quad j=1,\dots,(J-1), \quad l=1,\dots,L$$
$$\log(\psi0_j) \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\log(\psi1_{g,j}) \sim \mathcal{N}_{J}(\log(\psi0), \Omega^{-1}), \quad g=1,\dots,G, \quad j1=,\dots,J$$
$$\Omega \sim \mathcal{W}_{J+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_J$$
$$\tau_j \sim \mathcal{HC}(25), \quad j=1,\dots,J$$
\subsection{Data}
\code{G <- 6 \#Number of Multilevel Groups (decision-makers, households, etc.) \\
J <- 3 \#Number of products \\
K <- 4 \#Number of product attributes \\
L <- 5 \#Number of decision-maker attributes \\
N <- 30 \#Number of records \\
X1 <- matrix(rnorm(N*K), N, K) \#Product attributes \\
X2 <- matrix(rnorm(N*L), N, L) \#Decision-maker attributes \\
Sigma <- matrix(runif((J-1)*(J-1),-1,1),J-1,J-1) \\
diag(Sigma) <- runif(J-1,1,5) \\
Sigma <- as.positive.definite(Sigma) / 100 \\
alpha <- runif(J) \\
log.beta <- rnorm(K,0,0.1) \\
log.delta <- matrix(rnorm((J-1)*L,0,0.1), J-1, L) \\
log.psi0 <- rnorm(J) \\
log.psi1 <- rmvn(G, log.psi0, Sigma) \\
m <- rcat(N, rep(1/G,G)) \# Multilevel group indicator \\
Z <- as.indicator.matrix(m) \\
Y <- matrix(0, N, J) \\
Y <- round(exp(tcrossprod(Z, t(cbind(log.psi1,0))) + \\
\hspace*{0.27 in} matrix(tcrossprod(X1, t(log.beta)), N, J) + \\
\hspace*{0.27 in} tcrossprod(X2, rbind(log.delta, colSums(log.delta)*-1))) * \\
\hspace*{0.27 in} (Y + 1)\textasciicircum matrix(alpha,N,J,byrow=TRUE) + \\
\hspace*{0.27 in} matrix(rnorm(N*J,0,0.1),N,J)) \\
S <- diag(J) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=rep(0,J), log.beta=rep(0,K), \\
\hspace*{0.27 in} log.delta=matrix(0,J-1,L), log.psi0=rep(0,J), \\
\hspace*{0.27 in} log.psi1=matrix(0,G,J), tau=rep(0,J), U=S), \\
\hspace*{0.27 in} uppertri=c(0,0,0,0,0,0,1)) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.log.beta <- grep("log.beta", parm.names) \\
pos.log.delta <- grep("delta", parm.names) \\
pos.log.psi0 <- grep("log.psi0", parm.names) \\
pos.log.psi1 <- grep("log.psi1", parm.names) \\
pos.tau <- grep("tau", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- runif(Data$J,0.9,1) \\
\hspace*{0.27 in} log.beta <- rnorm(Data$K,0,0.1) \\
\hspace*{0.27 in} log.delta <- rnorm((Data$J-1)*Data$L,0,0.1) \\
\hspace*{0.27 in} log.psi0 <- rnorm(Data$J) \\
\hspace*{0.27 in} U <- rwishartc(Data$J+1, Data$S) \\
\hspace*{0.27 in} log.psi1 <- as.vector(rmvnpc(Data$G, log.psi0, U)) \\
\hspace*{0.27 in} tau <- runif(Data$J) \\
\hspace*{0.27 in} return(c(alpha, log.beta, log.delta, log.psi0, log.psi1, tau, \\
\hspace*{0.62 in} U[upper.tri(U, diag=TRUE)])) \\
\hspace*{0.27 in} \} \\
MyData <- list(G=G, J=J, K=K, L=L, N=N, PGF=PGF, S=S, X1=X1, X2=X2, Y=Y, \\
\hspace*{0.27 in} Z=Z, m=m, mon.names=mon.names, parm.names=parm.names, \\
\hspace*{0.27 in} pos.alpha=pos.alpha, pos.log.beta=pos.log.beta, \\
\hspace*{0.27 in} pos.log.delta=pos.log.delta, pos.log.psi0=pos.log.psi0, \\
\hspace*{0.27 in} pos.log.psi1=pos.log.psi1, pos.tau=pos.tau) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} parm[Data$pos.alpha] <- alpha <- interval(parm[Data$pos.alpha], 0, 1) \\
\hspace*{0.27 in} log.beta <- parm[Data$pos.log.beta] \\
\hspace*{0.27 in} log.delta <- matrix(parm[Data$pos.log.delta], Data$J-1, Data$L) \\
\hspace*{0.27 in} log.psi0 <- parm[Data$pos.log.psi0] \\
\hspace*{0.27 in} log.psi1 <- matrix(parm[Data$pos.log.psi1], Data$G, Data$J) \\
\hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\
\hspace*{0.27 in} U <- as.parm.matrix(U, Data$J, parm, Data, chol=TRUE) \\
\hspace*{0.27 in} diag(U) <- exp(diag(U)) \\
\hspace*{0.27 in} lambda <- tcrossprod(Data$Z, t(log.psi1)) + \\
\hspace*{0.62 in} matrix(tcrossprod(Data$X1, t(log.beta)), Data$N, Data$J) + \\
\hspace*{0.62 in} tcrossprod(Data$X2, rbind(log.delta, colSums(log.delta)*-1)) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} U.prior <- dwishartc(U, Data$J+1, Data$S, log=TRUE) \\
\hspace*{0.27 in} alpha.prior <- sum(dunif(alpha, 0, 1, log=TRUE)) \\
\hspace*{0.27 in} log.beta.prior <- sum(dnormv(log.beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} log.delta.prior <- sum(dnormv(log.delta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} log.psi0.prior <- sum(dnormv(log.psi0, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} log.psi1.prior <- sum(dmvnpc(lambda, \\
\hspace*{0.62 in} matrix(log.psi0, Data$N, Data$J, byrow=TRUE), U, log=TRUE)) \\
\hspace*{0.27 in} tau.prior <- sum(dhalfcauchy(tau, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} alpha <- matrix(alpha, Data$N, Data$J, byrow=TRUE) \\
\hspace*{0.27 in} lambda <- exp(lambda)*(Data$Y + 1)\textasciicircum alpha \\
\hspace*{0.27 in} tau <- matrix(tau, Data$N, Data$J, byrow=TRUE) \\
\hspace*{0.27 in} LL <- sum(dgamma(Data$Y+1, lambda*tau, tau, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + U.prior + alpha.prior + log.beta.prior + log.delta.prior + \\
\hspace*{0.62 in} log.psi0.prior + log.psi1.prior + tau.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rgamma(prod(dim(lambda)), lambda*tau, tau)-1, \\
\hspace*{0.62 in} parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(runif(J,0.9,1), rnorm(K,0,0.1), \\
\hspace*{0.27 in} rnorm((J-1)*L,0,0.1), rnorm(J,0,0.1), \\
\hspace*{0.27 in} rmvnpc(G, rnorm(J,0,0.1), rwishartc(J+1,S)), runif(J), \\
\hspace*{0.27 in} upper.triangle(rwishartc(J+1,S), diag=TRUE))}

\section{Multivariate Binary Probit} \label{multiv.bin.probit}
\subsection{Form}
$$\textbf{W}_{i,1:J} \sim \mathcal{N}_J(\mu_{i,1:J}, \Omega^{-1}), \quad i=1,\dots,N$$
\[\textbf{W}_{i,j} \in \left\{
\begin{array}{l l}
 $[0,10]$ & \quad \mbox{if $\textbf{y}_i = j$}\\
 $[-10,0]$ \\ \end{array} \right. \]
$$\mu_{1:N,j} = \textbf{X} \beta_{j,1:K}$$
$$\Omega = \rho^{-1}$$
$$\beta_{j,k} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,(J-1), \quad k=1,\dots,K$$
$$\beta_{J,k} = - \sum^{J-1}_{j=1} \beta_{j,k}$$
$$\rho \sim \mathcal{U}(-1, 1)$$
\subsection{Data}
\code{N <- 30 \\
J <- 2 \#Number of binary dependent variables \\
K <- 3 \#Number of columns to be in design matrix X \\
X <- cbind(1, matrix(rnorm(N*(K-1),0,1), N, K-1)) \\
beta <- matrix(rnorm(J*K), J, K) \\
mu <- tcrossprod(X, beta) \\
u <- runif(length(which(upper.tri(diag(J)) == TRUE)), -1, 1) \\
rho <- diag(J) \\
rho[upper.tri(rho)] <- u \\
rho[lower.tri(rho)] <- t(rho)[lower.tri(rho)] \\
rho <- as.positive.semidefinite(rho) \\
Omega <- as.inverse(rho) \\
U <- chol(Omega) \\
W <- interval(rmvnpc(N, mu, U) + matrix(rnorm(N*J,0,0.1), N, J), \\
\hspace*{0.27 in} -10, 10) \\
Y <- 1 * (W >= 0) \\
apply(Y, 2, table) \\
mon.names <- "LP" \\
rho <- matrix(NA, J, J) \\
rho[upper.tri(rho)] <- 0 \\
parm.names <- as.parm.names(list(beta=matrix(0,J,K), rho=rho, \\
\hspace*{0.27 in} W=matrix(0,N,J))) \\
pos.beta <- grep("beta", parm.names) \\
pos.rho <- grep("rho", parm.names) \\
pos.W <- grep("W", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J*Data$K) \\
\hspace*{0.27 in} rho <- rep(0, length(which(upper.tri(diag(Data$J))))) \\
\hspace*{0.27 in} W <- matrix(runif(Data$N*Data$J,-10,0), Data$N, Data$J) \\
\hspace*{0.27 in} W <- ifelse(Y == 1, abs(W), W) \\
\hspace*{0.27 in} return(c(beta, rho, as.vector(W)))\} \\
MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, Y=Y, \\
\hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, \\
\hspace*{0.27 in} pos.rho=pos.rho, pos.W=pos.W) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$J, Data$K) \\
\hspace*{0.27 in} u <- interval(parm[Data$pos.rho], -1, 1) \\
\hspace*{0.27 in} rho <- diag(MyData$J) \\
\hspace*{0.27 in} rho[upper.tri(rho)] <- u \\
\hspace*{0.27 in} rho[lower.tri(rho)] <- t(rho)[lower.tri(rho)] \\
\hspace*{0.27 in} if(is.positive.semidefinite(rho) == FALSE) \\
\hspace*{0.62 in} rho <- as.positive.semidefinite(rho) \\
\hspace*{0.27 in} parm[Data$pos.rho] <- upper.triangle(rho) \\
\hspace*{0.27 in} Omega <- as.inverse(rho) \\
\hspace*{0.27 in} U <- chol(Omega) \\
\hspace*{0.27 in} W <- matrix(parm[Data$pos.W], Data$N, Data$J) \\
\hspace*{0.27 in} W[Data$Y == 0] <- interval(W[Data$Y == 0], -10, 0) \\
\hspace*{0.27 in} W[Data$Y == 1] <- interval(W[Data$Y == 1], 0, 10) \\
\hspace*{0.27 in} parm[Data$pos.W] <- as.vector(W) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} rho.prior <- sum(dunif(u, -1, 1, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) \\
\hspace*{0.27 in} LL <- sum(dmvnpc(W, mu, U, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + rho.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=1*(rmvnpc(nrow(mu), mu, U) >= 0), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- GIV(Model, MyData, PGF=TRUE)}

\section{Multivariate Laplace Regression} \label{multivariate.lap.reg}
\subsection{Form}
$$\textbf{Y}_{i,k} \sim \mathcal{L}_K(\mu_{i,k}, \Sigma), \quad i=1,\dots,N; \quad k=1,\dots,K$$
$$\mu_{i,k} = \textbf{X}_{1:N,k} \beta_{k,1:J}$$
$$\Sigma = \Omega^{-1}$$
$$\Omega \sim \mathcal{W}_{K+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_K$$
$$\beta_{k,j} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
\subsection{Data}
\code{data(mtcars) \\
Y <- as.matrix(mtcars[,c(1,7)]) \\
X <- cbind(1, as.matrix(mtcars[,c(3,4,6)])) \\
N <- nrow(Y) \#Number of records \\
J <- ncol(X) \#Number of columns in design matrix \\
K <- ncol(Y) \#Number of DVs \\
S <- diag(K) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=matrix(0,K,J), U=diag(K)), \\
\hspace*{0.27 in} uppertri=c(0,1)) \\
pos.beta <- grep("beta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$K*Data$J) \\
\hspace*{0.27 in} U <- rwishartc(Data$K+1, Data$S) \\
\hspace*{0.27 in} return(c(beta, U[upper.tri(U, diag=TRUE)])) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, K=K, N=N, PGF=PGF, S=S, X=X, Y=Y, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$K, Data$J) \\
\hspace*{0.27 in} U <- as.parm.matrix(U, Data$K, parm, Data, chol=TRUE) \\
\hspace*{0.27 in} diag(U) <- exp(diag(U)) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} U.prior <- dwishart(U, Data$K+1, Data$S, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) \\
\hspace*{0.27 in} LL <- sum(dmvlc(Data$Y, mu, U, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + U.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rmvlc(nrow(mu), mu, U), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J*K), upper.triangle(S, diag=TRUE))}

\section{Multivariate Poisson Regression} \label{multivariate.pois.reg}
\subsection{Form}
$$\textbf{Y}_{i,k} \sim \mathcal{P}(\lambda_{i,k}), \quad i=1,\dots,N \quad k=1,\dots,K$$
$$\lambda_{i,k} = \exp(\textbf{X}_{i,k}\beta_{k,1:J} + \gamma_{i,k}), \quad i=1,\dots,N, \quad k=1,\dots,K$$
$$\beta_{k,j} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J, \quad k=1,\dots,K$$
$$\gamma_{i,1:K} \sim \mathcal{N}_K(0, \Omega^{-1}), \quad i=1,\dots,N$$
$$\Omega \sim \mathcal{W}_{K+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_K$$  
\subsection{Data}
\code{N <- 20 \#Number of records \\
J <- 4 \#Number of columns in design matrix \\
K <- 3 \#Number of DVs \\
X <- matrix(runif(N*J),N,J); X[,1] <- 1 \\
beta <- matrix(rnorm(K*J),K,J) \\
Omega <- matrix(runif(K*K),K,K); diag(Omega) <- runif(K,1,K) \\
Omega <- as.symmetric.matrix(Omega) \\
gamma <- rmvnp(N, 0, Omega) \\
Y <- round(exp(tcrossprod(X, beta) + gamma)) \\
S <- diag(K) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=matrix(0,K,J), gamma=matrix(0,N,K), \\
\hspace*{0.27 in} U=S), uppertri=c(0,0,1)) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$K*Data$J) \\
\hspace*{0.27 in} gamma <- rnorm(Data$N*Data$K) \\
\hspace*{0.27 in} U <- rwishartc(Data$K+1, Data$S) \\
\hspace*{0.27 in} return(c(beta, gamma, U[upper.tri(U, diag=TRUE)])) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, K=K, N=N, PGF=PGF, S=S, X=X, Y=Y, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$K, Data$J) \\
\hspace*{0.27 in} gamma <- matrix(parm[Data$pos.gamma], Data$N, Data$K) \\
\hspace*{0.27 in} U <- as.parm.matrix(U, Data$K, parm, Data, chol=TRUE) \\
\hspace*{0.27 in} diag(U) <- exp(diag(U)) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} gamma.prior <- sum(dmvnpc(gamma, 0, U, log=TRUE)) \\
\hspace*{0.27 in} U.prior <- dwishartc(U, Data$K+1, Data$S, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} lambda <- exp(tcrossprod(Data$X, beta) + gamma) \\
\hspace*{0.27 in} LL <- sum(dpois(Data$Y, lambda, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + U.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rpois(prod(dim(lambda)), lambda), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \}
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,K*J), rep(0,N*K), rep(0,K*(K+1)/2))}

\section{Multivariate Regression} \label{multivariate.reg}
\subsection{Form}
$$\textbf{Y}_{i,k} \sim \mathcal{N}_K(\mu_{i,k}, \Sigma), \quad i=1,\dots,N; \quad k=1,\dots,K$$
$$\mu_{i,k} = \textbf{X}_{1:N,k} \beta_{k,1:J}$$
$$\Sigma \sim \mathcal{HW}_{2}(\gamma, 1e6)$$
$$\beta_{k,j} \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J, \quad k=1,\dots,K$$
\subsection{Data}
\code{data(mtcars) \\
Y <- as.matrix(mtcars[,c(1,7)]) \\
X <- cbind(1, as.matrix(mtcars[,c(3,4,6)])) \\
N <- nrow(Y) \#Number of records \\
J <- ncol(X) \#Number of columns in design matrix \\
K <- ncol(Y) \#Number of DVs \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=matrix(0,K,J), gamma=rep(0,K), \\
\hspace*{0.27 in} U=diag(K)), uppertri=c(0,0,1)) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$K*Data$J) \\
\hspace*{0.27 in} gamma <- runif(Data$K) \\
\hspace*{0.27 in} U <- rhuangwandc(2, gamma, rep(1,Data$K)) \\
\hspace*{0.27 in} return(c(beta, gamma, U[upper.tri(U, diag=TRUE)])) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, Y=Y, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$K, Data$J) \\
\hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.gamma] <- gamma \\
\hspace*{0.27 in} U <- as.parm.matrix(U, Data$K, parm, Data, chol=TRUE) \\
\hspace*{0.27 in} diag(U) <- exp(diag(U)) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} HW.prior <- dhuangwandc(U, 2, gamma, rep(1e6,Data$K), log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, beta) \\
\hspace*{0.27 in} LL <- sum(dmvnc(Data$Y, mu, U, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + U.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rmvnc(nrow(mu), mu, U), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J*K), rep(1,K), rep(0,K*(K+1)/2))}

\section{Negative Binomial Regression} \label{negbin.reg}
This example was contributed by Jim Robison-Cox.
\subsection{Form}
$$\textbf{y} \sim \mathcal{NB}(\mu, \kappa)$$
$$p = \frac{\kappa}{\kappa + \mu}$$
$$\mu = \exp(\textbf{X} \beta)$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\kappa \sim \mathcal{HC}(25) \in (0,\infty]$$
\subsection{Data}
\code{N <- 100 \\
J <- 5 \#Number of predictors, including the intercept \\
kappa.orig <- 2 \\
beta.orig <- runif(J,-2,2) \\
X <- matrix(runif(J*N,-2, 2), N, J); X[,1] <- 1 \\
mu <- exp(tcrossprod(X, t(beta.orig)) + rnorm(N)) \\
p <- kappa.orig / (kappa.orig + mu) \\
y <- rnbinom(N, size=kappa.orig, mu=mu) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), kappa=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.kappa <- grep("kappa", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} kappa <- runif(1) \\
\hspace*{0.27 in} return(c(beta, kappa)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.kappa=pos.kappa, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} parm[Data$J + 1] <- kappa <- interval(parm[Data$pos.kappa], \\
\hspace*{0.62 in} .Machine$double.xmin, Inf) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} kappa.prior <- dhalfcauchy(kappa, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- as.vector(exp(tcrossprod(Data$X, t(beta)))) \\
\hspace*{0.27 in} \#p <- kappa / (kappa + mu) \\
\hspace*{0.27 in} LL <- sum(dnbinom(Data$y, size=kappa, mu=mu, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + kappa.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnbinom(length(mu), size=kappa, mu=mu), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 1)}

\section{Normal, Multilevel} \label{norm.ml}
This is Gelman's school example \citep{gelman04}. Note that \pkg{LaplacesDemon} is slower to converge than \proglang{WinBUGS} through the \pkg{R2WinBUGS} package \citep{r:r2winbugs}, an \proglang{R} package on CRAN. This example is very sensitive to the prior distributions. The recommended, default, half-Cauchy priors with scale 25 on scale parameters overwhelms the likelihood, so uniform priors are used.
\subsection{Form}
$$\textbf{y}_j \sim \mathcal{N}(\theta_j, \sigma^2_j), \quad j=1,\dots,J$$
$$\theta_j \sim \mathcal{N}(\theta_{\mu}, \theta_\sigma^2)$$
$$\theta_{\mu} \sim \mathcal{N}(0, 1000000)$$
$$\theta_{\sigma[j]} \sim \mathcal{N}(0, 1000)$$
$$\sigma \sim \mathcal{U}(0, 1000)$$
\subsection{Data}
\code{J <- 8 \\
y <- c(28.4, 7.9, -2.8, 6.8, -0.6, 0.6, 18.0, 12.2) \\
sd <- c(14.9, 10.2, 16.3, 11.0, 9.4, 11.4, 10.4, 17.6) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(theta=rep(0,J), theta.mu=0, \\
\hspace*{0.27 in} theta.sigma=0)) \\
pos.theta <- 1:J \\
pos.theta.mu <- J+1 \\
pos.theta.sigma <- J+2 \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} theta.mu <- rnorm(1) \\
\hspace*{0.27 in} theta.sigma <- runif(1) \\
\hspace*{0.27 in} theta <- rnorm(Data$J, theta.mu, theta.sigma) \\
\hspace*{0.27 in} return(c(theta, theta.mu, theta.sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, mon.names=mon.names, parm.names=parm.names, \\
\hspace*{0.27 in} pos.theta=pos.theta, pos.theta.mu=pos.theta.mu, \\
\hspace*{0.27 in} pos.theta.sigma=pos.theta.sigma, sd=sd, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Hyperparameters \\
\hspace*{0.27 in} theta.mu <- parm[Data$pos.theta.mu] \\
\hspace*{0.27 in} theta.sigma <- interval(parm[Data$pos.theta.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.theta.sigma] <- theta.sigma \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} theta <- parm[Data$pos.theta] \\
\hspace*{0.27 in} \#\#\# Log-Hyperprior \\
\hspace*{0.27 in} theta.mu.prior <- dnormp(theta.mu, 0, 1.0E-6, log=TRUE) \\
\hspace*{0.27 in} theta.sigma.prior <- dunif(theta.sigma, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} theta.prior <- sum(dnorm(theta, theta.mu, theta.sigma, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dunif(Data$sd, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, theta, Data$sd, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + theta.prior + theta.mu.prior + theta.sigma.prior + \\
\hspace*{0.62 in} sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(theta), theta, Data$sd), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(mean(y),J), mean(y), 1)}

\section{Ordinal Logit} \label{ordinal.logit}
\subsection{Form}
$$\textbf{y}_i \sim \mathcal{CAT}(P_{i,1:J})$$
$$P_{,J} = 1 - Q_{,(J-1)}$$
$$P_{,j} = |Q_{,j} - Q_{,(j-1)}|, \quad j=2,\dots,(J-1)$$
$$P_{,1} = Q_{,1}$$
$$Q = \frac{1}{1 + \exp(\mu)}$$
$$\mu_{,j} = \delta_j - \textbf{X} \beta, \quad \in [-5,5]$$
$$\beta_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$
$$\delta_j \sim \mathcal{N}(0, 1) \in [(j-1),j] \in [-5,5], \quad j=1,\dots,(J-1)$$
\subsection{Data}
\code{data(demonsnacks) \\
N <- nrow(demonsnacks) \\
J <- 3 \#Number of categories in y \\
X <- as.matrix(demonsnacks[,c(1,3:10)]) \\
K <- ncol(demonsnacks) \#Number of columns in design matrix X \\
y <- log(demonsnacks$Calories) \\
y <- ifelse(y < 4.5669, 1, ifelse(y > 5.5268, 3, 2)) \#Discretize \\
for (k in 1:K) X[,k] <- CenterScale(X[,k]) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,K), delta=rep(0,J-1))) \\
pos.beta <- grep("beta", parm.names) \\
pos.delta <- grep("delta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$K) \\
\hspace*{0.27 in} delta <- sort(rnorm(Data$J-1)) \\
\hspace*{0.27 in} return(c(beta, delta)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.delta=pos.delta, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], -5, 5) \\
\hspace*{0.27 in} delta <- sort(delta) \\
\hspace*{0.27 in} parm[Data$pos.delta] <- delta \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} delta.prior <- sum(dtrunc(delta, "norm", a=-5, b=5, log=TRUE, \\
\hspace*{0.62 in} mean=0, sd=1) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- matrix(delta, Data$N, Data$J-1, byrow=TRUE) - \\
\hspace*{0.62 in} matrix(tcrossprod(Data$X, t(beta)), Data$N, Data$J-1) \\
\hspace*{0.27 in} P <- Q <- invlogit(mu) \\
\hspace*{0.27 in} P[,-1] <- abs(Q[,-1] - Q[,-(Data$J-1)]) \\
\hspace*{0.27 in} P <- cbind(P, 1 - Q[,(Data$J-1)]) \\
\hspace*{0.27 in} LL <- sum(dcat(Data$y, P, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + delta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(P), P) \\
\hspace*{0.62 in} parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,K), seq(from=-1, to=1, len=(J-1)))}

\section{Ordinal Probit} \label{ordinal.probit}
\subsection{Form}
$$\textbf{y}_i \sim \mathcal{CAT}(P_{i,1:J})$$
$$P_{,J} = 1 - Q_{,(J-1)}$$
$$P_{,j} = |Q_{,j} - Q_{,(j-1)}|, \quad j=2,\dots,(J-1)$$
$$P_{,1} = Q_{,1}$$
$$Q = \phi(\mu)$$
$$\mu_{,j} = \delta_j - \textbf{X} \beta, \quad \in [-5,5]$$
$$\beta_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$
$$\delta_j \sim \mathcal{N}(0, 1) \in [(j-1),j] \in [-5,5], \quad j=1,\dots,(J-1)$$
\subsection{Data}
\code{data(demonsnacks) \\
N <- nrow(demonsnacks) \\
J <- 3 \#Number of categories in y \\
X <- as.matrix(demonsnacks[,c(1,3:10)]) \\
K <- ncol(demonsnacks) \#Number of columns in design matrix X \\
y <- log(demonsnacks$Calories) \\
y <- ifelse(y < 4.5669, 1, ifelse(y > 5.5268, 3, 2)) \#Discretize \\
for (k in 1:K) X[,k] <- CenterScale(X[,k]) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,K), delta=rep(0,J-1))) \\
pos.beta <- grep("beta", parm.names) \\
pos.delta <- grep("delta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$K) \\
\hspace*{0.27 in} delta <- sort(rnorm(Data$J-1)) \\
\hspace*{0.27 in} return(c(beta, delta)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, K=K, N=N, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.delta=pos.delta, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], -5, 5) \\
\hspace*{0.27 in} delta <- sort(delta) \\
\hspace*{0.27 in} parm[Data$pos.delta] <- delta \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} delta.prior <- sum(dtrunc(delta, "norm", a=-5, b=5, log=TRUE, \\
\hspace*{0.62 in} mean=0, sd=1) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- matrix(delta, Data$N, Data$J-1, byrow=TRUE) - \\
\hspace*{0.62 in} matrix(tcrossprod(Data$X, t(beta)), Data$N, Data$J-1) \\
\hspace*{0.27 in} P <- Q <- pnorm(mu) \\
\hspace*{0.27 in} P[,-1] <- abs(Q[,-1] - Q[,-(Data$J-1)]) \\
\hspace*{0.27 in} P <- cbind(P, 1 - Q[,(Data$J-1)]) \\
\hspace*{0.27 in} LL <- sum(dcat(Data$y, P, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + delta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=rcat(nrow(P), P) \\
\hspace*{0.62 in} parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,K), seq(from=-1, to=1, len=(J-1)))}

\section{Panel, Autoregressive Poisson} \label{panel.ap}
\subsection{Form}
$$\textbf{Y} \sim \mathcal{P}(\Lambda)$$
$$\Lambda_{1:N,1} = \exp(\alpha + \beta \textbf{x})$$
$$\Lambda_{1:N,t} = \exp(\alpha + \beta \textbf{x} + \rho \log(\textbf{Y}_{1:N,t-1})), \quad t=2,\dots,T$$
$$\alpha_i \sim \mathcal{N}(\alpha_\mu, \alpha^2_\sigma), \quad i=1,\dots,N$$
$$\alpha_\mu \sim \mathcal{N}(0, 1000)$$
$$\alpha_\sigma \sim \mathcal{HC}(25)$$
$$\beta \sim \mathcal{N}(0, 1000)$$
$$\rho \sim \mathcal{N}(0, 1000)$$
\subsection{Data}
\code{N <- 10 \\
T <- 10 \\
alpha <- rnorm(N,2,0.5) \\
rho <- 0.5 \\
beta <- 0.5 \\
x <- runif(N,0,1) \\
Y <- matrix(NA,N,T) \\
Y[,1] <- exp(alpha + beta*x) \\
for (t in 2:T) \{Y[,t] <- exp(alpha + beta*x + rho*log(Y[,t-1]))\} \\
Y <- round(Y) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=rep(0,N), alpha.mu=0, \\
\hspace*{0.27 in} alpha.sigma=0, beta=0, rho=0)) \\
pos.alpha <- 1:N \\
pos.alpha.mu <- grep("alpha.mu", parm.names) \\
pos.alpha.sigma <- grep("alpha.sigma", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.rho <- grep("rho", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha.mu <- rnorm(1) \\
\hspace*{0.27 in} alpha.sigma <- runif(1) \\
\hspace*{0.27 in} alpha <- rnorm(Data$N, alpha.mu, alpha.sigma) \\
\hspace*{0.27 in} beta <- rnorm(1) \\
\hspace*{0.27 in} rho <- rnorm(1) \\
\hspace*{0.27 in} return(c(alpha, alpha.mu, alpha.sigma, beta, rho)) \\
\hspace*{0.27 in} \} \\
MyData <- list(N=N, PGF=PGF, T=T, Y=Y, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.alpha.mu=pos.alpha.mu, \\
\hspace*{0.27 in} pos.alpha.sigma=pos.alpha.sigma, pos.beta=pos.beta, pos.rho=pos.rho, \\
\hspace*{0.27 in} x=x) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Hyperparameters \\
\hspace*{0.27 in} alpha.mu <- parm[Data$pos.alpha.mu] \\
\hspace*{0.27 in} alpha.sigma <- interval(parm[Data$pos.alpha.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.alpha.sigma] <- alpha.sigma \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} rho <- parm[Data$pos.rho] \\
\hspace*{0.27 in} \#\#\# Log-Hyperprior \\
\hspace*{0.27 in} alpha.mu.prior <- dnormv(alpha.mu, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} alpha.sigma.prior <- dhalfcauchy(alpha.sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- sum(dnorm(alpha, alpha.mu, alpha.sigma, log=TRUE)) \\
\hspace*{0.27 in} beta.prior <- dnormv(beta, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} rho.prior <- dnormv(rho, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} Lambda <- Data$Y \\
\hspace*{0.27 in} Lambda[,1] <- exp(alpha + beta*x) \\
\hspace*{0.27 in} Lambda[,2:Data$T] <- exp(alpha + beta*Data$x + \\
\hspace*{0.62 in} rho*log(Data$Y[,1:(Data$T-1)])) \\
\hspace*{0.27 in} LL <- sum(dpois(Data$Y, Lambda, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + alpha.mu.prior + alpha.sigma.prior + \\
\hspace*{0.62 in} beta.prior + rho.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rpois(prod(dim(Lambda)), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,N), 0, 1, 0, 0)}

\section{Penalized Spline Regression} \label{pspline}
This example applies penalized splines to one predictor in a linear regression. The user selects the degree of the polynomial, $D$, and the number of knots, $K$.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2_1)$$
$$\mu = \textbf{X} \beta + \textbf{S}$$
$$\textbf{S} = \textbf{Z} \gamma$$
\[\textbf{Z}_{i,k} = \left\{
\begin{array}{l l}
  (\textbf{x}_i - k)^D & \quad \mbox{if $\textbf{Z}_{i,k} > 0$}\\ 
  0 \\ \end{array} \right. \]
$$\beta_d \sim \mathcal{N}(0, 1000), \quad d=1,\dots,(D+1)$$
$$\gamma_k \sim \mathcal{N}(0, \sigma^2_2), \quad k=1,\dots,K$$
$$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,2$$
\subsection{Data}
\code{N <- 100 \\
x <- 1:N \\
y <- sin(2*pi*x/N) + runif(N,-1,1) \\
K <- 10 \#Number of knots \\
D <- 2 \#Degree of polynomial \\
x <- CenterScale(x) \\
k <- as.vector(quantile(x, probs=(1:K / (K+1)))) \\
X <- cbind(1, matrix(x, N, D)) \\
for (d in 1:D) \{X[,d+1] <- X[,d+1]\textasciicircum d\} \\
Z <- matrix(x, N, K) - matrix(k, N, K, byrow=TRUE) \\
Z <- ifelse(Z > 0, Z, 0); Z <- Z\textasciicircum D \\
mon.names <- c("LP", paste("S[", 1:nrow(X) ,"]", sep="")) \\
parm.names <- as.parm.names(list(beta=rep(0,1+D), gamma=rep(0,K), \\
\hspace*{0.27 in} log.sigma=rep(0,2))) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(1+Data$D) \\
\hspace*{0.27 in} gamma <- rnorm(Data$K) \\
\hspace*{0.27 in} sigma <- runif(2) \\
\hspace*{0.27 in} return(c(beta, gamma, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(D=D, K=K, N=N, PGF=PGF, Z=Z, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, \\
\hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} gamma.prior <- sum(dnorm(gamma, 0, sigma[2], log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} S <- as.vector(tcrossprod(Data$Z, t(gamma))) \\
\hspace*{0.27 in} mu <- as.vector(tcrossprod(Data$X, t(beta))) + S \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,S), \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,1+D), rep(0,K), c(1,1))}

\section{Poisson Regression} \label{poisson.reg}
\subsection{Form}
$$\textbf{y} \sim \mathcal{P}(\lambda)$$
$$\lambda = \exp(\textbf{X}\beta)$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
\subsection{Data}
\code{N <- 10000 \\
J <- 5 \\
X <- matrix(runif(N*J,-2,2),N,J); X[,1] <- 1 \\
beta <- runif(J,-2,2) \\
y <- round(exp(tcrossprod(X, t(beta)))) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J))) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} return(beta) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} lambda <- exp(tcrossprod(Data$X, t(beta))) \\
\hspace*{0.27 in} LL <- sum(dpois(Data$y, lambda, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rpois(length(lambda), lambda), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- rep(0,J)}

\section{Polynomial Regression} \label{polynomial.reg}
In this univariate example, the degree of the polynomial is specified as $D$. For a more robust extension to estimating nonlinear relationships between $\textbf{y}$ and $\textbf{x}$, see penalized spline regression in section \ref{penalized.spline}.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu = \textbf{X} \beta$$
$$\textbf{X}_{i,d} = \textbf{x}^{d-1}_i, \quad d=1,\dots,(D+1)$$
$$\textbf{X}_{i,1} = 1$$
$$\beta_d \sim \mathcal{N}(0, 1000), \quad d=1,\dots,(D+1)$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonsnacks) \\
N <- nrow(demonsnacks) \\
D <- 2 \#Degree of polynomial \\
y <- log(demonsnacks$Calories) \\
x <- log(demonsnacks[,10]+1) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,D+1), sigma=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(1+Data$D) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(beta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(D=D, N=N, PGF=PGF, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, x=x, \\
\hspace*{0.27 in} y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} X <- matrix(Data$x, Data$N, Data$D) \\
\hspace*{0.27 in} for (d in 2:Data$D) \{X[,d] <- X[,d]\textasciicircum d\} \\
\hspace*{0.27 in} X <- cbind(1,X) \\
\hspace*{0.27 in} mu <- tcrossprod(X, t(beta)) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,D+1), 1)}

\section{Proportional Hazards Regression, Weibull} \label{prop.haz.weib}
Although the dependent variable is usually denoted as $\textbf{t}$ in survival analysis, it is denoted here as $\textbf{y}$ so Laplace's Demon recognizes it as a dependent variable for posterior predictive checks. This example does not support censoring, but it will be included soon.
\subsection{Form}
$$\textbf{y}_i \sim \mathcal{WEIB}(\gamma, \mu_i), \quad i=1,\dots,N$$
$$\mu = \exp(\textbf{X} \beta)$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\gamma \sim \mathcal{G}(1, 0.001)$$
\subsection{Data}
\code{N <- 50 \\
J <- 5 \\
X <- matrix(runif(N*J,-2,2),N,J); X[,1] <- 1 \\
beta <- c(1,runif(J-1,-1,1)) \\
y <- round(exp(tcrossprod(X, t(beta)))) + 1 \# Undefined at zero \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), gamma=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} gamma <- rgamma(1,1e-3) \\
\hspace*{0.27 in} return(c(beta, gamma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, N=N, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.gamma] <- gamma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} gamma.prior <- dgamma(gamma, 1, 1.0E-3, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- exp(tcrossprod(Data$X, t(beta))) \\
\hspace*{0.27 in} LL <- sum(dweibull(Data$y, gamma, mu, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rweibull(length(mu), gamma, mu), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 1)}

\section{PVAR(p)} \label{pvarp}
This is a Poisson vector autoregression, with autoregressive order $p$, for multivariate time-series of counts. It allows for dynamic processes and accounts for overdispersion.
\subsection{Form}
$$\textbf{Y}_{t,j} \sim \mathcal{P}(\lambda_{t,j}), \quad t=1,\dots,T \quad j=1,\dots,J$$
$$\lambda_{t,j} = \sum^P_{p=1} \Phi_{1:J,j,p} \textbf{Y}_{t-p,j} + \exp(\alpha_j + \gamma_{t,j})$$
$$\alpha_j \sim \mathcal{N}(0, 1000)$$
$$\Phi_{i,k,p} \sim \mathcal{N}(\Phi^\mu_{i,k,p}, \Sigma_{i,k,p}), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$
$$\gamma_{t,1:J} \sim \mathcal{N}_J(0, \Omega^{-1}), \quad t=1,\dots,T$$
$$\Omega \sim \mathcal{W}_{J+1}(\textbf{S}), \quad \textbf{S} = \textbf{I}_J$$
where $\Phi^\mu$ and $\Sigma$ are set according to the Minnesota prior.
\subsection{Data}
\code{data(demonsessions) \\
Y.orig <- as.matrix(demonsessions) \\
Y <- Y.orig[1:24,1:5] \\
T <- nrow(Y) \\
J <- ncol(Y) \\
L <- c(1,2,3) \#Autoregressive lags \\
P <- length(L) \#Autoregressive order \\
Phi.mu <- array(0, dim=c(J,J,P)) \\
Phi.mu[, , 1] <- diag(J) \\
S <- diag(J) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=rep(0,J), \\
\hspace*{0.27 in} Phi=array(0, dim=c(J,J,P)), gamma=matrix(0,T-L[P],J), U=S), \\
\hspace*{0.27 in} uppertri=c(0,0,0,1)) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.Phi <- grep("Phi", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(Data$J) \\
\hspace*{0.27 in} Phi <- runif(Data$J*Data$J*Data$P, -1e-10, 1e-10) \\
\hspace*{0.27 in} gamma <- rnorm((Data$T-Data$L[Data$P])*Data$J) \\
\hspace*{0.27 in} U <- rwishartc(Data$J+1, diag(Data$J)) \\
\hspace*{0.27 in} return(c(alpha, Phi, gamma, U[upper.tri(U, diag=TRUE)])) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, L=L, P=P, PGF=PGF, Phi.mu=Phi.mu, S=S, T=T, Y=Y, \\
\hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\
\hspace*{0.27 in} pos.Phi=pos.Phi, pos.gamma=pos.gamma) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} Phi <- array(parm[Data$pos.Phi], dim=c(Data$J, Data$J, Data$P)) \\
\hspace*{0.27 in} gamma <- matrix(parm[Data$pos.gamma], Data$T-Data$L[Data$P], Data$J) \\
\hspace*{0.27 in} U <- as.parm.matrix(U, Data$J, parm, Data, chol=TRUE) \\
\hspace*{0.27 in} diag(U) <- exp(diag(U)) \\
\hspace*{0.27 in} Omega <- t(U) \%*\% U \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} Sigma <- MinnesotaPrior(Data$J, lags=Data$L, lambda=1, theta=0.5, \\
\hspace*{0.62 in} diag(as.inverse(Omega))) \\
\hspace*{0.27 in} Phi.prior <- sum(dnormv(Phi, Data$Phi.mu, Sigma, log=TRUE)) \\
\hspace*{0.27 in} gamma.prior <- sum(dmvnp(gamma, 0, Omega, log=TRUE)) \\
\hspace*{0.27 in} U.prior <- dwishart(Omega, Data$J+1, Data$S, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} lambda <- exp(matrix(alpha, Data$T, Data$J, byrow=TRUE) + \\
\hspace*{0.62 in} rbind(matrix(0, Data$L[Data$P], Data$J), gamma)) \\
\hspace*{0.27 in} for (p in 1:Data$P) \\
\hspace*{0.62 in} lambda[(1+Data$L[p]):Data$T,] <- lambda[(1+Data$L[p]):Data$T,] + \\
\hspace*{0.95 in} Data$Y[1:(Data$T-Data$L[p]),] %*% Phi[, , p] \\
\hspace*{0.27 in} LL <- sum(dpois(Data$Y[(1+Data$L[Data$P]):Data$T,], \\
\hspace*{0.62 in} lambda[(1+Data$L[Data$P]):Data$T,], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + Phi.prior + gamma.prior + U.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rpois(prod(dim(lambda)), lambda), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \}
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), rep(0,J*J*P), rep(0,(T-L[P])*J), \\
\hspace*{0.27 in} rep(0,J*(J+1)/2))}

\section{Quantile Regression} \label{quantile.reg}
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\phi, \sigma^2)$$
$$\phi = \frac{(1 - 2P)}{P(1 - P)} \zeta + \mu$$
$$\mu = \textbf{X} \beta$$
$$\sigma = \frac{P (1 - P) \tau}{2 \zeta}$$
$$\beta \sim \mathcal{N}(0, 1000)$$
$$\tau \sim \mathcal{HC}(25)$$
$$\zeta \sim \mathcal{EXP}(\tau)$$
where $P$ is the user-specified quantile in $(0,1)$.
\subsection{Data}
\code{data(demonsnacks) \\
y <- log(demonsnacks$Calories) \\
X <- cbind(1, as.matrix(log(demonsnacks[,c(1,4,10)]+1))) \\
N <- nrow(X) \\
J <- ncol(X) \\
P <- 0.5 \#Quantile in (0,1) \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), tau=0, zeta=rep(0,N))) \\
pos.beta <- grep("beta", parm.names) \\
pos.tau <- grep("tau", parm.names) \\
pos.zeta <- grep("zeta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} tau <- runif(1) \\
\hspace*{0.27 in} zeta <- rexp(Data$N, tau) \\
\hspace*{0.27 in} return(c(beta, tau, zeta)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, N=N, P=P, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.tau=pos.tau, \\
\hspace*{0.27 in} pos.zeta=pos.zeta, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\
\hspace*{0.27 in} zeta <- interval(parm[Data$pos.zeta], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.zeta] <- zeta \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\
\hspace*{0.27 in} zeta.prior <- sum(dexp(zeta, tau, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} phi <- (1 - 2*Data$P) / (Data$P*(1 - Data$P))*zeta + mu \\
\hspace*{0.27 in} sigma <- (Data$P*(1 - Data$P)*tau) / (2*zeta) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, phi, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + tau.prior + zeta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(phi), phi, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \}
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 1, rep(1,N))}

\section{Revision, Normal} \label{revision.normal}
This example provides both an analytic solution and numerical approximation of the revision of a normal distribution. Given a normal prior distribution ($\alpha$) and data distribution ($\beta$), the posterior ($\gamma$) is the revised normal distribution. This is an introductory example of Bayesian inference, and allows the user to experiment with numerical approximation, such as with MCMC in \code{LaplacesDemon}. Note that, regardless of the data sample size $N$ in this example, Laplace Approximation is inappropriate due to asymptotics since the data ($\beta$) is perceived by the algorithm as a single datum rather than a collection of data. MCMC, on the other hand, is biased only by the effective number of samples taken of the posterior. \\
\code{\#\#\# Analytic Solution \\
prior.mu <- 0 \\
prior.sigma <- 10 \\
N <- 10 \\
data.mu <- 1 \\
data.sigma <- 2 \\
posterior.mu <- (prior.sigma\textasciicircum -2 * prior.mu + N * data.sigma\textasciicircum -2 * data.mu) / \\
\hspace*{0.27 in} (prior.sigma\textasciicircum -2 + N * data.sigma\textasciicircum -2) \\
posterior.sigma <- sqrt(1/(prior.sigma\textasciicircum -2 + data.sigma\textasciicircum -2)) \\
posterior.mu \\
posterior.sigma \\
}
\subsection{Form}
$$\alpha \sim \mathcal{N}(0,10)$$
$$\beta \sim \mathcal{N}(1,2)$$
$$\gamma = \frac{\alpha^{-2}_\sigma \alpha + N \beta^{-2}_\sigma \beta}{\alpha^{-2}_\sigma + N \beta^{-2}_\sigma}$$
\subsection{Data}
\code{N <- 10 \\
mon.names <- c("LP","gamma") \\
parm.names <- c("alpha","beta") \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(1,0,10) \\
\hspace*{0.27 in} beta <- rnorm(1,1,2) \\
\hspace*{0.27 in} return(c(alpha, beta)) \\
\hspace*{0.27 in} \} \\
MyData <- list(N=N, PGF=PGF, mon.names=mon.names, parm.names=parm.names) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Hyperparameters \\
\hspace*{0.27 in} alpha.mu <- 0 \\
\hspace*{0.27 in} alpha.sigma <- 10 \\
\hspace*{0.27 in} beta.mu <- 1 \\
\hspace*{0.27 in} beta.sigma <- 2 \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[1] \\
\hspace*{0.27 in} beta <- parm[2] \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dnorm(alpha, alpha.mu, alpha.sigma, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} LL <- dnorm(beta, beta.mu, beta.sigma, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Posterior \\
\hspace*{0.27 in} gamma <- (alpha.sigma\textasciicircum -2 * alpha + N * beta.sigma\textasciicircum -2 * beta) / \\
\hspace*{0.62 in} (alpha.sigma\textasciicircum -2 + N * beta.sigma\textasciicircum -2) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,gamma), \\
\hspace*{0.62 in} yhat=rnorm(1, beta.mu, beta.sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(0,0)}

\section{Ridge Regression} \label{ridge.reg}
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2_1)$$
$$\mu = \textbf{X}\beta$$
$$\beta_1 \sim \mathcal{N}(0, 1000)$$
$$\beta_j \sim \mathcal{N}(0, \sigma^2_2), \quad j=2,\dots,J$$
$$\sigma_k \sim \mathcal{HC}(25), \quad k=1,\dots,2$$
\subsection{Data}
\code{data(demonsnacks) \\
y <- log(demonsnacks$Calories) \\
X <- cbind(1, as.matrix(log(demonsnacks[,-2]+1))) \\
J <- ncol(X) \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), sigma=rep(0,2))) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} sigma <- runif(2) \\
\hspace*{0.27 in} return(c(beta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, c(1000, rep(sigma[2], Data$J-1)), \\
\hspace*{0.62 in} log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[1], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma[1]), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(1,J), rep(1,2))}

\section{Robust Regression} \label{robust.reg}
By replacing the normal distribution with the Student t distribution, linear regression is often called robust regression. As an alternative approach to robust regression, consider Laplace regression (see section \ref{laplace.reg}).
\subsection{Form}
$$\textbf{y} \sim \mathrm{t}(\mu, \sigma^2, \nu)$$
$$\mu = \textbf{X}\beta$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\sigma \sim \mathcal{HC}(25)$$
$$\nu \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{N <- 100 \\
J <- 5 \\
X <- matrix(1,N,J) \\
for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\
beta <- runif(J,-3,3) \\
e <- rst(N,0,1,5) \\
y <- tcrossprod(X, t(beta)) + e \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0, nu=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
pos.nu <- grep("nu", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} nu <- runif(1) \\
\hspace*{0.27 in} return(c(beta, sigma, nu)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, \\
\hspace*{0.27 in} pos.nu=pos.nu, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[1:Data$J] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} parm[Data$pos.nu] <- nu <- interval(parm[Data$pos.nu], 1e-100, Inf) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} nu.prior <- dhalfcauchy(nu, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} LL <- sum(dst(Data$y, mu, sigma, nu, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior + nu.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rst(length(mu), mu, sigma, nu), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 1, 5)}

\section{Seemingly Unrelated Regression (SUR)} \label{sur}
The following data was used by \citet{zellner62} when introducing the Seemingly Unrelated Regression methodology. This model uses the Yang-Berger prior distribution for the precision matrix of a multivariate normal distribution.
\subsection{Form}
$$\textbf{Y}_{t,k} \sim \mathcal{N}_K(\mu_{t,k}, \Omega^{-1}), \quad t=1,\dots,T, \quad k=1,\dots,K$$
$$\mu_{1,t} = \alpha_1 + \alpha_2 \textbf{X}_{t-1,1} + \alpha_3 \textbf{X}_{t-1,2}, \quad t=2,\dots,T$$
$$\mu_{2,t} = \beta_1 + \beta_2 \textbf{X}_{t-1,3} + \beta_3 \textbf{X}_{t-1,4}, \quad t=2,\dots,T$$
$$\alpha_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
where $J=3$, $K=2$, and $T=20$.
\subsection{Data}
\code{T <- 20 \#Time-periods \\
year <- c(1935,1936,1937,1938,1939,1940,1941,1942,1943,1944,1945,1946, \\
\hspace*{0.27 in} 1947,1948,1949,1950,1951,1952,1953,1954) \\
IG <- c(33.1,45.0,77.2,44.6,48.1,74.4,113.0,91.9,61.3,56.8,93.6,159.9, \\
\hspace*{0.27 in} 147.2,146.3,98.3,93.5,135.2,157.3,179.5,189.6) \\
VG <- c(1170.6,2015.8,2803.3,2039.7,2256.2,2132.2,1834.1,1588.0,1749.4, \\
\hspace*{0.27 in} 1687.2,2007.7,2208.3,1656.7,1604.4,1431.8,1610.5,1819.4,2079.7, \\
\hspace*{0.27 in} 2371.6,2759.9) \\
CG <- c(97.8,104.4,118.0,156.2,172.6,186.6,220.9,287.8,319.9,321.3,319.6, \\
\hspace*{0.27 in} 346.0,456.4,543.4,618.3,647.4,671.3,726.1,800.3,888.9) \\
IW <- c(12.93,25.90,35.05,22.89,18.84,28.57,48.51,43.34,37.02,37.81, \\
\hspace*{0.27 in} 39.27,53.46,55.56,49.56,32.04,32.24,54.38,71.78,90.08,68.60) \\
VW <- c(191.5,516.0,729.0,560.4,519.9,628.5,537.1,561.2,617.2,626.7, \\
\hspace*{0.27 in} 737.2,760.5,581.4,662.3,583.8,635.2,723.8,864.1,1193.5,1188.9) \\
CW <- c(1.8,0.8,7.4,18.1,23.5,26.5,36.2,60.8,84.4,91.2,92.4,86.0,111.1, \\
\hspace*{0.27 in} 130.6,141.8,136.7,129.7,145.5,174.8,213.5) \\
J <- 2 \#Number of dependent variables \\
Y <- matrix(c(IG,IW), T, J) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=rep(0,3), beta=rep(0,3), \\
\hspace*{0.27 in} U=diag(J)), uppertri=c(0,0,1)) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(3) \\
\hspace*{0.27 in} beta <- rnorm(3) \\
\hspace*{0.27 in} U <- runif(Data$J*(Data$J+1)/2) \\
\hspace*{0.27 in} return(c(alpha, beta, U)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, T=T, Y=Y, CG=CG, CW=CW, IG=IG, IW=IW, \\
\hspace*{0.27 in} VG=VG, VW=VW, mon.names=mon.names, parm.names=parm.names, \\
\hspace*{0.27 in} pos.alpha=pos.alpha, pos.beta=pos.beta) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} U <- as.parm.matrix(U, Data$J, parm, Data, chol=TRUE) \\
\hspace*{0.27 in} diag(U) <- exp(diag(U)) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} U.prior <- dyangbergerc(U, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- Data$Y \\
\hspace*{0.27 in} mu[-1,1] <- alpha[1] + alpha[2]*Data$CG[-Data$T] + \\
\hspace*{0.62 in} alpha[3]*Data$VG[-Data$T] \\
\hspace*{0.27 in} mu[-1,2] <- beta[1] + beta[2]*Data$CW[-Data$T] + \\
\hspace*{0.62 in} beta[3]*Data$VW[-Data$T] \\
\hspace*{0.27 in} LL <- sum(dmvnpc(Data$Y[-1,], mu[-1,], U, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + U.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rmvnpc(nrow(mu), mu, U), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,3), rep(0,3), rep(0,J*(J+1)/2))}

\section{Simultaneous Equations} \label{simultaneous}
This example of simultaneous equations uses Klein's Model I \citep{kleine50} regarding economic fluctations in the United States in 1920-1941 (\textbf{N}=22). Usually, this example is modeled with 3-stage least sqaures (3SLS), excluding the uncertainty from multiple stages. By constraining each element in the instrumental variables matrix $\nu \in [-10,10]$, this example estimates the model without resorting to stages. The dependent variable is matrix \textbf{Y}, in which $\textbf{Y}_{1,1:N}$ is \textbf{C} or Consumption, $\textbf{Y}_{2,1:N}$ is \textbf{I} or Investment, and $\textbf{Y}_{3,1:N}$ is \textbf{Wp} or Private Wages. Here is a data dictionary: \\
\code{\hspace*{0.27 in} A = Time Trend measured as years from 1931 \\
\hspace*{0.27 in} \textbf{C} = Consumption \\
\hspace*{0.27 in} \textbf{G} = Government Nonwage Spending \\
\hspace*{0.27 in} \textbf{I} = Investment \\
\hspace*{0.27 in} \textbf{K} = Capital Stock \\
\hspace*{0.27 in} \textbf{P} = Private (Corporate) Profits \\
\hspace*{0.27 in} \textbf{T} = Indirect Business Taxes Plus Neg Exports \\
\hspace*{0.27 in} \textbf{Wg} = Government Wage Bill \\
\hspace*{0.27 in} \textbf{Wp} = Private Wages \\
\hspace*{0.27 in} \textbf{X} = Equilibrium Demand (GNP) \\
}
See \citet{kleine50} for more information.
\subsection{Form}
$$\textbf{Y} \sim \mathcal{N}_3(\mu, \Omega^{-1})$$
$$ \mu_{1,1} = \alpha_1 + \alpha_2 \nu_{1,1} + \alpha_4 \nu_{2,1}$$
$$ \mu_{1,i} = \alpha_1 + \alpha_2 \nu_{1,i} + \alpha_3 \textbf{P}_{i-1} + \alpha_4 \nu_{2,i}, \quad i=2,\dots,N$$
$$ \mu_{2,1} = \beta_1 + \beta_2 \nu_{1,1} + \beta_4 \textbf{K}_1$$
$$ \mu_{2,i} = \beta_1 + \beta_2 \nu_{1,i} + \beta_3 \textbf{P}_{i-1} + \beta_4 \textbf{K}_i, \quad i=2,\dots,N$$
$$\mu_{3,1} = \gamma_1 + \gamma_2 \nu_{3,1} + \gamma_4 \textbf{A}_1$$
$$\mu_{3,i} = \gamma_1 + \gamma_2 \nu_{3,i} + \gamma_3 \textbf{X}_{i-1} + \gamma_4 \textbf{A}_i, \quad i=2,\dots,N$$
$$\textbf{Z}_{j,i} \sim \mathcal{N}(\nu_{j,i}, \sigma^2_j), \quad j=1,\dots,3$$
$$\nu_{j,1} = \pi_{j,1} + \pi_{j,3} \textbf{K}_1 + \pi_{j,5} \textbf{A}_1 + \pi_{j,6} \textbf{T}_1 + \pi_{j,7} \textbf{G}_1, \quad j=1,\dots,3$$
$$\nu_{j,i} = \pi_{j,1} + \pi_{j,2} \textbf{P}_{i-1} + \pi_{j,3} \textbf{K}_i + \pi_{j,4} \textbf{X}_{i-1} + \pi_{j,5} \textbf{A}_i + \pi_{j,6} \textbf{T}_i + \pi \textbf{G}_i, \quad i=1,\dots,N, \quad j=1,\dots,3$$
$$\alpha_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,4$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,4$$
$$\gamma_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,4$$
$$\pi_{j,i} \sim \mathcal{N}(0, 1000) \in [-10,10], \quad j=1,\dots,3, \quad i=1,\dots,N$$
$$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,3$$
$$\Omega \sim \mathcal{W}_4(\textbf{S}), \quad \textbf{S} = \textbf{I}_3$$
\subsection{Data}
\code{N <- 22 \\
A <- c(-11,-10,-9,-8,-7,-6,-5,-4,-3,-2,-1,0,1,2,3,4,5,6,7,8,9,10) \\
C <- c(39.8,41.9,45,49.2,50.6,52.6,55.1,56.2,57.3,57.8,55,50.9,45.6,46.5, \\
\hspace*{0.27 in} 48.7,51.3,57.7,58.7,57.5,61.6,65,69.7) \\
G <- c(2.4,3.9,3.2,2.8,3.5,3.3,3.3,4,4.2,4.1,5.2,5.9,4.9,3.7,4,4.4,2.9,4.3, \\
\hspace*{0.27 in} 5.3,6.6,7.4,13.8) \\
I <- c(2.7,-0.2,1.9,5.2,3,5.1,5.6,4.2,3,5.1,1,-3.4,-6.2,-5.1,-3,-1.3,2.1,2, \\
\hspace*{0.27 in} -1.9,1.3,3.3,4.9) \\
K <- c(180.1,182.8,182.6,184.5,189.7,192.7,197.8,203.4,207.6,210.6,215.7, \\
\hspace*{0.27 in} 216.7,213.3,207.1,202,199,197.7,199.8,201.8,199.9,201.2,204.5) \\
P <- c(12.7,12.4,16.9,18.4,19.4,20.1,19.6,19.8,21.1,21.7,15.6,11.4,7,11.2, \\
\hspace*{0.27 in} 12.3,14,17.6,17.3,15.3,19,21.1,23.5) \\
T <- c(3.4,7.7,3.9,4.7,3.8,5.5,7,6.7,4.2,4,7.7,7.5,8.3,5.4,6.8,7.2,8.3,6.7, \\
\hspace*{0.27 in} 7.4,8.9,9.6,11.6) \\
Wg <- c(2.2,2.7,2.9,2.9,3.1,3.2,3.3,3.6,3.7,4,4.2,4.8,5.3,5.6,6,6.1,7.4, \\
\hspace*{0.27 in} 6.7,7.7,7.8,8,8.5) \\
Wp <- c(28.8,25.5,29.3,34.1,33.9,35.4,37.4,37.9,39.2,41.3,37.9,34.5,29,28.5, \\
\hspace*{0.27 in} 30.6,33.2,36.8,41,38.2,41.6,45,53.3) \\
X <- c(44.9,45.6,50.1,57.2,57.1,61,64,64.4,64.5,67,61.2,53.4,44.3,45.1, \\
\hspace*{0.27 in} 49.7,54.4,62.7,65,60.9,69.5,75.7,88.4) \\
year <- c(1920,1921,1922,1923,1924,1925,1926,1927,1928,1929,1930,1931,1932, \\
\hspace*{0.27 in} 1933,1934,1935,1936,1937,1938,1939,1940,1941) \\
Y <- matrix(c(C,I,Wp),3,N, byrow=TRUE) \\
Z <- matrix(c(P, Wp+Wg, X), 3, N, byrow=TRUE) \\
S <- diag(nrow(Y)) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=rep(0,4), beta=rep(0,4), \\
\hspace*{0.27 in} gamma=rep(0,4), pi=matrix(0,3,7), sigma=rep(0,3), \\
\hspace*{0.27 in} U=diag(3)), uppertri=c(0,0,0,0,0,1)) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
pos.pi <- grep("pi", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(4) \\
\hspace*{0.27 in} beta <- rnorm(4) \\
\hspace*{0.27 in} gamma <- rnorm(4) \\
\hspace*{0.27 in} pi <- rnorm(3*7) \\
\hspace*{0.27 in} sigma <- runif(3) \\
\hspace*{0.27 in} U <- rwishartc(ncol(Data$Y)+1, Data$S) \\
\hspace*{0.27 in} return(c(alpha, beta, gamma, pi, sigma, U[upper.tri(U, diag=TRUE)])) \\
\hspace*{0.27 in} \} \\
MyData <- list(A=A, C=C, G=G, I=I, K=K, N=N, P=P, PGF=PGF, S=S, T=T, Wg=Wg, \\
\hspace*{0.27 in} Wp=Wp, X=X, Y=Y, Z=Z, mon.names=mon.names, parm.names=parm.names, \\
\hspace*{0.27 in} pos.alpha=pos.alpha, pos.beta=pos.beta, pos.gamma=pos.gamma, \\
\hspace*{0.27 in} pos.pi=pos.pi, pos.sigma=pos.sigma) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\
\hspace*{0.27 in} parm[Data$pos.pi] <- pi <- interval(parm[Data$pos.pi], -10, 10) \\
\hspace*{0.27 in} pi <- matrix(pi, 3, 7)
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma
\hspace*{0.27 in} U <- as.parm.matrix(U, nrow(Data$S), parm, Data, chol=TRUE) \\
\hspace*{0.27 in} parm[grep("Omega", Data$parm.names)] <- upper.triangle(Omega, \\
\hspace*{0.62 in} diag=TRUE) \\
\hspace*{0.27 in} diag(U) <- exp(diag(U)) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} gamma.prior <- sum(dnormv(gamma, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} pi.prior <- sum(dnormv(pi, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} U.prior <- dwishartc(U, nrow(Data$S)+1, Data$S, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- nu <- matrix(0,3,Data$N) \\
\hspace*{0.27 in} for (i in 1:3) \{ \\
\hspace*{0.62 in} nu[i,1] <- pi[i,1] + pi[i,3]*Data$K[1] + pi[i,5]*Data$A[1] + \\
\hspace*{0.95 in} pi[i,6]*Data$T[1] + pi[i,7]*Data$G[1] \\
\hspace*{0.62 in} nu[i,-1] <- pi[i,1] + pi[i,2]*Data$P[-Data$N] + \\
\hspace*{0.95 in} pi[i,3]*Data$K[-1] + pi[i,4]*Data$X[-Data$N] + \\
\hspace*{0.95 in} pi[i,5]*Data$A[-1] + pi[i,6]*Data$T[-1] + \\
\hspace*{0.95 in} pi[i,7]*Data$G[-1]\} \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$Z, nu, matrix(sigma, 3, Data$N), log=TRUE)) \\
\hspace*{0.27 in} mu[1,1] <- alpha[1] + alpha[2]*nu[1,1] + alpha[4]*nu[2,1] \\
\hspace*{0.27 in} mu[1,-1] <- alpha[1] + alpha[2]*nu[1,-1] + \\
\hspace*{0.62 in} alpha[3]*Data$P[-Data$N] + alpha[4]*nu[2,-1] \\
\hspace*{0.27 in} mu[2,1] <- beta[1] + beta[2]*nu[1,1] + beta[4]*Data$K[1] \\
\hspace*{0.27 in} mu[2,-1] <- beta[1] + beta[2]*nu[1,-1] + \\
\hspace*{0.62 in} beta[3]*Data$P[-Data$N] + beta[4]*Data$K[-1] \\
\hspace*{0.27 in} mu[3,1] <- gamma[1] + gamma[2]*nu[3,1] + gamma[4]*Data$A[1] \\
\hspace*{0.27 in} mu[3,-1] <- gamma[1] + gamma[2]*nu[3,-1] + \\
\hspace*{0.62 in} gamma[3]*Data$X[-Data$N] + gamma[4]*Data$A[-1] \\
\hspace*{0.27 in} LL <- LL + sum(dmvnpc(t(Data$Y), t(mu), U, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + gamma.prior + pi.prior + \\
\hspace*{0.62 in} sigma.prior + U.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=t(rmvnp(ncol(mu), t(mu), U)), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,4), rep(0,4), rep(0,4), rep(0,3*7), rep(1,3), \\
\hspace*{0.27 in} upper.triangle(S, diag=TRUE))}

\section{Space-Time, Dynamic} \label{spacetime.dynamic}
This approach to space-time or spatiotemporal modeling applies kriging to a stationary spatial component for points in space $s=1,\dots,S$ first at time $t=1$, where space is continuous and time is discrete. Vector $\zeta$ contains these spatial effects. Next, SSM (State Space Model) or DLM (Dynamic Linear Model) components are applied to the spatial parameters ($\phi$, $\kappa$, and $\lambda$) and regression effects ($\beta$). These parameters are allowed to vary dynamically with time $t=2,\dots,T$, and the resulting spatial process is estimated for each of these time-periods. When time is discrete, a dynamic space-time process can be applied. The matrix $\Theta$ contains the dynamically varying stationary spatial effects, or space-time effects. Spatial coordinates are given in longitude and latitude for $s=1,\dots,S$ points in space and measurements are taken across discrete time-periods $t=1,\dots,T$ for $\textbf{Y}_{s,t}$. The dependent variable is also a function of design matrix $\textbf{X}$ (which may also be dynamic, but is static in this example) and dynamic regression effects matrix $\beta_{1:K,1:T}$. For more information on kriging, see section \ref{kriging}. For more information on SSMs or DLMs, see section \ref{ssm.lin.reg}. To extend this to a large spatial data set, consider incorporating the predictive process kriging example in section \ref{kriging.pp}.
\subsection{Form}
$$\textbf{Y}_{s,t} \sim \mathcal{N}(\mu_{s,t}, \sigma^2_1), \quad s=1,\dots,S, \quad t=1,\dots,T$$
$$\mu_{s,t} = \textbf{X}_{s,1:K} \beta_{1:K,t} + \Theta_{s,t}$$
$$\Theta_{s,t} = \frac{\Sigma_{s,s,t}}{\sum^S_{r=1} \Sigma_{r,s,t}} \Theta_{s,t-1}, \quad s=1,\dots,S, \quad t=2,\dots,T$$
$$\Theta_{s,1} = \zeta_s$$
$$\zeta \sim \mathcal{N}_S(0, \Sigma_{1:S,1:S,1})$$
$$\Sigma_{1:S,1:S,t} = \lambda^2_t \exp(-\phi_t \textbf{D})^{\kappa[t]}$$
$$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,4$$
$$\beta_{k,1} \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$
$$\beta_{k,t} \sim \mathcal{N}(\beta_{k,t-1}, \tau^2_k), \quad k=1,\dots,K, \quad t=2,\dots,T$$
$$\phi_1 \sim \mathcal{HN}(1000)$$
$$\phi_t \sim \mathcal{N}(\phi_{t-1}, \sigma^2_2) \in [0,\infty], \quad t=2,\dots,T$$
$$\kappa_1 \sim \mathcal{HN}(1000)$$
$$\kappa_t \sim \mathcal{N}(\kappa_{t-1}, \sigma^2_3) \in [0,\infty], \quad t=2,\dots,T$$
$$\lambda_1 \sim \mathcal{HN}(1000)$$
$$\lambda_t \sim \mathcal{N}(\lambda_{t-1}, \sigma^2_4) \in [0,\infty], \quad t=2,\dots,T$$
\subsection{Data}
\code{data(demontexas) \\
Y <- as.matrix(demontexas[1:20,c(18:30)]) \\
X <- cbind(1,as.matrix(demontexas[1:20,c(1,4)])) \#Static predictors \\
latitude <- demontexas[1:20,2] \\
longitude <- demontexas[1:20,3] \\
D <- as.matrix(dist(cbind(longitude,latitude), diag=TRUE, upper=TRUE)) \\
S <- nrow(Y) \#Number of sites, or points in space \\
T <- ncol(Y) \#Number of time-periods \\
K <- ncol(X) \#Number of columns in design matrix X including the intercept \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(zeta=rep(0,S), beta=matrix(0,K,T), \\
\hspace*{0.27 in} phi=rep(0,T), kappa=rep(0,T), lambda=rep(0,T), sigma=rep(0,4), \\
\hspace*{0.27 in} tau=rep(0,K))) \\
pos.zeta <- grep("zeta", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.kappa <- grep("kappa", parm.names) \\
pos.lambda <- grep("lambda", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
pos.tau <- grep("tau", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$K*Data$T, rbind(mean(Data$Y), \\
\hspace*{0.62 in} matrix(0, Data$K-1, Data$T)), 1)  \\
\hspace*{0.27 in} phi <- rhalfnorm(Data$T, 1) \\
\hspace*{0.27 in} kappa <- rhalfnorm(Data$T, 1) \\
\hspace*{0.27 in} lambda <- rhalfnorm(Data$T, 1) \\
\hspace*{0.27 in} Sigma <- lambda[1]*lambda[1]*exp(-phi[1]*Data$D)\textasciicircum kappa[1] \\
\hspace*{0.27 in} zeta <- as.vector(rmvn(1, rep(0,Data$S), Sigma)) \\
\hspace*{0.27 in} sigma <- runif(4) \\
\hspace*{0.27 in} tau <- runif(Data$K) \\
\hspace*{0.27 in} return(c(zeta, beta, phi, kappa, lambda, sigma, tau)) \\
\hspace*{0.27 in} \} \\
MyData <- list(D=D, K=K, PGF=PGF, S=S, T=T, X=X, Y=Y, latitude=latitude, \\
\hspace*{0.27 in} longitude=longitude, mon.names=mon.names, parm.names=parm.names, \\
\hspace*{0.27 in} pos.zeta=pos.zeta, pos.beta=pos.beta, pos.phi=pos.phi, \\
\hspace*{0.27 in} pos.kappa=pos.kappa, pos.lambda=pos.lambda, pos.sigma=pos.sigma, \\
\hspace*{0.27 in} pos.tau=pos.tau) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$K, Data$T) \\
\hspace*{0.27 in} zeta <- parm[Data$pos.zeta] \\
\hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1e-100, Inf) \\
\hspace*{0.27 in} kappa <- interval(parm[Data$pos.kappa], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.kappa] <- kappa \\
\hspace*{0.27 in} lambda <- interval(parm[Data$pos.lambda], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.lambda] <- lambda \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\
\hspace*{0.27 in} Sigma <- array(0, dim=c(Data$S, Data$S, Data$T)) \\
\hspace*{0.27 in} for (t in 1:Data$T) \{ \\
\hspace*{0.62 in} Sigma[ , ,t] <- lambda[t]\textasciicircum 2 * exp(-phi[t] * Data$D)\textasciicircum kappa[t]\} \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta[,1], 0, 1000, log=TRUE), \\
\hspace*{0.62 in} dnorm(beta[,-1], beta[,-Data$T], matrix(tau, Data$K, \\
\hspace*{0.62 in} Data$T-1), log=TRUE)) \\
\hspace*{0.27 in} zeta.prior <- dmvn(zeta, rep(0,Data$S), Sigma[ , , 1], log=TRUE) \\
\hspace*{0.27 in} phi.prior <- sum(dhalfnorm(phi[1], sqrt(1000), log=TRUE), \\
\hspace*{0.62 in} dtrunc(phi[-1], "norm", a=0, b=Inf, mean=phi[-Data$T], \\
\hspace*{0.62 in} sd=sigma[2], log=TRUE)) \\
\hspace*{0.27 in} kappa.prior <- sum(dhalfnorm(kappa[1], sqrt(1000), log=TRUE), \\
\hspace*{0.62 in} dtrunc(kappa[-1], "norm", a=0, b=Inf, mean=kappa[-Data$T], \\
\hspace*{0.62 in} sd=sigma[3], log=TRUE)) \\
\hspace*{0.27 in} lambda.prior <- sum(dhalfnorm(lambda[1], sqrt(1000), log=TRUE), \\
\hspace*{0.62 in} dtrunc(lambda[-1], "norm", a=0, b=Inf, mean=lambda[-Data$T], \\
\hspace*{0.62 in} sd=sigma[4], log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} tau.prior <- sum(dhalfcauchy(tau, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} Theta <- matrix(zeta, Data$S, Data$T) \\
\hspace*{0.27 in} for (t in 2:Data$T) \{ \\
\hspace*{0.62 in} for (s in 1:Data$S) \{ \\
\hspace*{0.98 in} Theta[s,t] <- sum(Sigma[,s,t] / sum(Sigma[,s,t]) * Theta[,t-1])\}\} \\
\hspace*{0.27 in} mu <- mu + Theta \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu, sigma[1], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + zeta.prior + sum(phi.prior) + \\
\hspace*{0.62 in} sum(kappa.prior) + sum(lambda.prior) + sigma.prior + tau.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, sigma[1]), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,S), rep(c(mean(Y),rep(0,K-1)),T), rep(1,T), \\
\hspace*{0.27 in} rep(1,T), rep(1,T), rep(1,4), rep(1,K))}

\section{Space-Time, Nonseparable} \label{spacetime.nonsep}
This approach to space-time or spatiotemporal modeling applies kriging both to the stationary spatial and temporal components, where space is continuous and time is discrete. Matrix $\Xi$ contains the space-time effects. Spatial coordinates are given in longitude and latitude for $s=1,\dots,S$ points in space and measurements are taken across time-periods $t=1,\dots,T$ for $\textbf{Y}_{s,t}$. The dependent variable is also a function of design matrix $\textbf{X}$ and regression effects vector $\beta$. For more information on kriging, see section \ref{kriging}. This example uses a nonseparable, stationary covariance function in which space and time are separable only when $\psi=0$. To extend this to a large space-time data set, consider incorporating the predictive process kriging example in section \ref{kriging.pp}.
\subsection{Form}
$$\textbf{Y}_{s,t} \sim \mathcal{N}(\mu_{s,t}, \sigma^2_1), \quad s=1,\dots,S, \quad t=1,\dots,T$$
$$\mu = \textbf{X} \beta + \Xi$$
$$\Xi \sim \mathcal{N}_{ST}(\Xi_\mu, \Sigma)$$
$$ \Sigma = \sigma^2_2 \exp \left (-\frac{\textbf{D}_S}{\phi_1}^\kappa - \frac{\textbf{D}_T}{\phi_2}^\lambda - \psi \frac{\textbf{D}_S}{\phi_1}^\kappa \frac{\textbf{D}_T}{\phi_2}^\lambda \right )$$
$$\beta_k \sim \mathcal{N}(0, 1000), \quad k=1,\dots,K$$
$$\phi_j \sim \mathcal{U}(1, 5), \quad j=1,\dots,2$$
$$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,2$$
$$\psi \sim \mathcal{HC}(25)$$
$$\Xi_\mu = 0$$
$$\kappa = 1, \quad \lambda = 1$$
\subsection{Data}
\code{data(demontexas) \\
Y <- as.matrix(demontexas[1:10,c(18:30)]) \\
X <- cbind(1,as.matrix(demontexas[1:10,c(1,4)])) \#Static predictors \\
latitude <- demontexas[1:10,2] \\
longitude <- demontexas[1:10,3] \\
S <- nrow(Y) \#Number of sites, or points in space \\
T <- ncol(Y) \#Number of time-periods \\
K <- ncol(X) \#Number of columns in design matrix X including the intercept \\
D.S <- as.matrix(dist(cbind(rep(longitude,T),rep(latitude,T)), diag=TRUE, \\
\hspace*{0.27 in} upper=TRUE)) \\
D.T <- as.matrix(dist(cbind(rep(1:T,each=S),rep(1:T,each=S)), diag=TRUE, \\
\hspace*{0.27 in} upper=TRUE)) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(Xi=matrix(0,S,T), beta=rep(0,K), \\
\hspace*{0.27 in} phi=rep(0,2), sigma=rep(0,2), psi=0)) \\
pos.Xi <- grep("Xi", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
pos.psi <- grep("psi", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$K, c(mean(Data$Y),rep(0,Data$K-1)), 1) \\
\hspace*{0.27 in} phi <- runif(2,1,5) \\
\hspace*{0.27 in} sigma <- runif(2) \\
\hspace*{0.27 in} psi <- runif(1) \\
\hspace*{0.27 in} kappa <- 1 \\
\hspace*{0.27 in} lambda <- 1 \\
\hspace*{0.27 in} Sigma <- sigma[2]*sigma[2] * exp(-(Data$D.S / phi[1])\textasciicircum kappa -
\hspace*{0.62 in} (Data$D.T / phi[2])\textasciicircum lambda -
\hspace*{0.62 in} psi*(Data$D.S / phi[1])\textasciicircum kappa * (Data$D.T / phi[2])\textasciicircum lambda)
\hspace*{0.27 in} Xi <- as.vector(rmvn(1, rep(0,Data$S*Data$T), Sigma)) \\
\hspace*{0.27 in} return(c(Xi, beta, phi, sigma, psi)) \\
\hspace*{0.27 in} \} \\
MyData <- list(D.S=D.S, D.T=D.T, K=K, PGF=PGF, S=S, T=T, X=X, Y=Y, \\
\hspace*{0.27 in} latitude=latitude, longitude=longitude, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.Xi=pos.Xi, pos.beta=pos.beta, \\
\hspace*{0.27 in} pos.phi=pos.phi, pos.sigma=pos.sigma, pos.psi=pos.psi) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Hyperparameters \\
\hspace*{0.27 in} Xi.mu <- rep(0,Data$S*Data$T) \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} Xi <- parm[Data$pos.Xi] \\
\hspace*{0.27 in} kappa <- 1; lambda <- 1 \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1, 5) \\
\hspace*{0.27 in} parm[Data$pos.psi] <- psi <- interval(parm[Data$pos.psi], 1e-100, Inf) \\
\hspace*{0.27 in} Sigma <- sigma[2]*sigma[2] * exp(-(Data$D.S / phi[1])\textasciicircum kappa - \\
\hspace*{0.62 in} (Data$D.T / phi[2])\textasciicircum lambda - \\
\hspace*{0.62 in} psi*(Data$D.S / phi[1])\textasciicircum kappa * (Data$D.T / phi[2])\textasciicircum lambda) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} Xi.prior <- dmvn(Xi, Xi.mu, Sigma, log=TRUE) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} phi.prior <- sum(dunif(phi, 1, 5, log=TRUE)) \\
\hspace*{0.27 in} psi.prior <- dhalfcauchy(psi, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} Xi <- matrix(Xi, Data$S, Data$T) \\
\hspace*{0.27 in} mu <- as.vector(tcrossprod(Data$X, t(beta))) + Xi \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu, sigma[1], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + Xi.prior + sigma.prior + phi.prior + psi.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, sigma[1]), parm=parm)\\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,S*T), c(mean(Y),rep(0,K-1)), rep(1,2), rep(1,2), \\
\hspace*{0.27 in} 1)}

\section{Space-Time, Separable} \label{spacetime.sep}
This introductory approach to space-time or spatiotemporal modeling applies kriging both to the stationary spatial and temporal components, where space is continuous and time is discrete. Vector $\zeta$ contains the spatial effects and vector $\theta$ contains the temporal effects. Spatial coordinates are given in longitude and latitude for $s=1,\dots,S$ points in space and measurements are taken across time-periods $t=1,\dots,T$ for $\textbf{Y}_{s,t}$. The dependent variable is also a function of design matrix $\textbf{X}$ and regression effects vector $\beta$. For more information on kriging, see section \ref{kriging}. This example uses separable space-time covariances, which is more convenient but usually less appropriate than a nonseparable covariance function. To extend this to a large space-time data set, consider incorporating the predictive process kriging example in section \ref{kriging.pp}.
\subsection{Form}
$$\textbf{Y}_{s,t} \sim \mathcal{N}(\mu_{s,t}, \sigma^2_1), \quad s=1,\dots,S, \quad t=1,\dots,T$$
$$\mu_{s,t} = \textbf{X}_{s,1:J} \beta + \zeta_s + \Theta_{s,t}$$
$$\Theta_{s,1:T} = \theta$$
$$\theta \sim \mathcal{N}_N(\theta_\mu, \Sigma_T)$$
$$\Sigma_T = \sigma^2_3 \exp(-\phi_2 \textbf{D}_T)^\lambda$$
$$\zeta \sim \mathcal{N}_N(\zeta_\mu, \Sigma_S)$$
$$\Sigma_S = \sigma^2_2 \exp(-\phi_1 \textbf{D}_S)^\kappa$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,2$$
$$\sigma_k \sim \mathcal{HC}(25), \quad k=1,\dots,3$$
$$\phi_k \sim \mathcal{U}(1, 5), \quad k=1,\dots,2$$
$$\zeta_\mu = 0$$
$$\theta_\mu = 0$$
$$\kappa = 1, \quad \lambda = 1$$
\subsection{Data}
\code{data(demontexas) \\
Y <- as.matrix(demontexas[1:20,c(18:30)]) \\
X <- cbind(1,as.matrix(demontexas[1:20,c(1,4)])) \#Static predictors \\
latitude <- demontexas[1:20,2] \\
longitude <- demontexas[1:20,3] \\
S <- nrow(Y) \#Number of sites, or points in space \\
T <- ncol(Y) \#Number of time-periods \\
K <- ncol(X) \#Number of columns in design matrix X including the intercept \\
D.S <- as.matrix(dist(cbind(longitude,latitude), diag=TRUE, upper=TRUE)) \\
D.T <- as.matrix(dist(cbind(c(1:T),c(1:T)), diag=TRUE, upper=TRUE)) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(zeta=rep(0,S), theta=rep(0,T), \\
\hspace*{0.27 in} beta=rep(0,K), phi=rep(0,2), sigma=rep(0,3))) \\
pos.zeta <- grep("zeta", parm.names) \\
pos.theta <- grep("theta", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$K, c(mean(Data$Y),rep(0,Data$K-1)), 1) \\
\hspace*{0.27 in} phi <- runif(2,1,5) \\
\hspace*{0.27 in} sigma <- runif(3) \\
\hspace*{0.27 in} kappa <- 1 \\
\hspace*{0.27 in} lambda <- 1 \\
\hspace*{0.27 in} Sigma.S <- sigma[2]\textasciicircum 2 * exp(-phi[1] * Data$D.S)\textasciicircum kappa \\
\hspace*{0.27 in} Sigma.T <- sigma[3]\textasciicircum 2 * exp(-phi[2] * Data$D.T)\textasciicircum lambda \\
\hspace*{0.27 in} zeta <- as.vector(rmvn(1, rep(0,Data$S), Sigma.S)) \\
\hspace*{0.27 in} theta <- as.vector(rmvn(1, rep(0,Data$T), Sigma.T)) \\
\hspace*{0.27 in} return(c(zeta, theta, beta, phi, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(D.S=D.S, D.T=D.T, K=K, PGF=PGF, S=S, T=T, X=X, Y=Y, \\
\hspace*{0.27 in} latitude=latitude, longitude=longitude, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.zeta=pos.zeta, pos.theta=pos.theta, \\
\hspace*{0.27 in} pos.beta=pos.beta, pos.phi=pos.phi, pos.sigma=pos.sigma) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Hyperparameters \\
\hspace*{0.27 in} zeta.mu <- rep(0,Data$S) \\
\hspace*{0.27 in} theta.mu <- rep(0,Data$T) \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} zeta <- parm[Data$pos.zeta] \\
\hspace*{0.27 in} theta <- parm[Data$pos.theta] \\
\hspace*{0.27 in} kappa <- 1; lambda <- 1 \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], 1, 5) \\
\hspace*{0.27 in} Sigma.S <- sigma[2]\textasciicircum 2 * exp(-phi[1] * Data$D.S)\textasciicircum kappa \\
\hspace*{0.27 in} Sigma.T <- sigma[3]\textasciicircum 2 * exp(-phi[2] * Data$D.T)\textasciicircum lambda \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} zeta.prior <- dmvn(zeta, zeta.mu, Sigma.S, log=TRUE) \\
\hspace*{0.27 in} theta.prior <- dmvn(theta, theta.mu, Sigma.T, log=TRUE) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} phi.prior <- sum(dunif(phi, 1, 5, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} Theta <- matrix(theta, Data$S, Data$T, byrow=TRUE) \\
\hspace*{0.27 in} mu <- as.vector(tcrossprod(Data$X, t(beta))) + zeta + Theta \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$Y, mu, sigma[1], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + zeta.prior + theta.prior + sigma.prior + \\
\hspace*{0.62 in} phi.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, sigma[1]), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,S), rep(0,T), rep(0,2), rep(1,2), rep(1,3))}

\section{Spatial Autoregression (SAR)} \label{sar}
The spatial autoregressive (SAR) model in this example uses areal data that consists of first-order neighbors that were specified and converted from point-based data with longitude and latitude coordinates.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu = \textbf{X}\beta + \phi \textbf{z}$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\phi \sim \mathcal{U}(-1, 1)$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{N <- 100 \\
latitude <- runif(N,0,100); longitude <- runif(N,0,100) \\
J <- 3 \#Number of predictors, including the intercept \\
X <- matrix(runif(N*J,0,3), N, J); X[,1] <- 1 \\
beta.orig <- runif(J,0,3); phi <- runif(1,0,1) \\
D <- as.matrix(dist(cbind(longitude, latitude), diag=TRUE, upper=TRUE)) \\
W <- exp(-D) \#Inverse distance as weights \\
W <- ifelse(D == 0, 0, W) \\
epsilon <- rnorm(N,0,1) \\
y <- tcrossprod(X, t(beta.orig)) + sqrt(latitude) + sqrt(longitude) + \\
\hspace*{0.27 in} epsilon \\
Z <- W / matrix(rowSums(W), N, N) * matrix(y, N, N, byrow=TRUE) \\
z <- rowSums(Z) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), phi=0, sigma=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} phi <- runif(1,-1,1) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(beta, phi, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, latitude=latitude, longitude=longitude, \\
\hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.beta=pos.beta, \\
\hspace*{0.27 in} pos.phi=pos.phi, pos.sigma=pos.sigma, y=y, z=z)}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], -1, 1) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} phi.prior <- dunif(phi, -1, 1, log=TRUE) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) + phi*Data$z \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + phi.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 0.5, 1)}

\section{STARMA(p,q)} \label{starma}
The data in this example of a space-time autoregressive moving average (STARMA) are coordinate-based, and the adjacency matrix \textbf{A} is created from $K$ nearest neighbors. Otherwise, an adjacency matrix may be specified as usual for areal data. Spatial coordinates are given in longitude and latitude for $s=1,\dots,S$ points in space and measurements are taken across time-periods $t=1,\dots,T$ for $\textbf{Y}_{s,t}$.
\subsection{Form}
$$\textbf{Y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu_{s,t} = \sum^J_{j=1} \textbf{X}_{s,t,j} \beta_j + \sum^L_{l=1} \sum^P_{p=1} \phi_{l,p} \textbf{W}^1_{s,t-p,l} + \sum^M_{m=1} \sum^Q_{q=1} \theta_{m,q} \textbf{W}^2_{s,t-q,m}, \quad j=1,\dots,J, \quad s=1,\dots,S, \quad t=p,\dots,T$$
$$\textbf{W}^1_{1:S,1:T,l} = \textbf{V}_{1:S,1:S,l} \textbf{Y}, \quad l=1,\dots,L$$
$$\textbf{W}^2_{1:S,1:T,m} = \textbf{V}_{1:S,1:S,m} \epsilon, \quad m=1,\dots,M$$
$$\epsilon = \textbf{Y} - \mu$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\phi_{l,p} \sim \mathcal{U}(-1, 1), \quad l=1,\dots,L, \quad p=1,\dots,P$$
$$\sigma \sim \mathcal{HC}(25)$$
$$\theta_{m,q} \sim \mathcal{N}(0, 1000), \quad m=1,\dots,M, \quad q=1,\dots,Q$$
where \textbf{V} is an adjacency array that is scaled so that each row sums to one, $\beta$ is a vector of regression effects, $\phi$ is a matrixr of autoregressive space-time parameters, $\sigma$ is the residual variance, and $\theta$ is a matrix of moving average space-time parameters.
\subsection{Data}
\code{data(demontexas) \\
Y <- t(diff(t(as.matrix(demontexas[,c(18:30)])))) \#Note this is not stationary \\
X <- array(1, dim=c(369,13-1,3)) \\
X[, , 2] <- CenterScale(demontexas[,1]) \\
X[, , 3] <- demontexas[,4] \\
latitude <- demontexas[,2] \\
longitude <- demontexas[,3] \\
S <- nrow(Y) \#Number of sites, or points in space \\
T <- ncol(Y) \#Number of time-periods \\
J <- dim(X)[3] \#Number of columns in design matrix X including the intercept \\
K <- 5 \#Number of nearest neighbors \\
L <- 2 \#Spatial autoregressive order \\
M <- 2 \#Spatial moving average order \\
P <- 2 \#Autoregressive order \\
Q <- 2 \#Moving average order \\
D <- as.matrix(dist(cbind(longitude, latitude), diag=TRUE, upper=TRUE)) \\
A <- V <- array(0, dim=c(nrow(D),ncol(D),P)) \\
W1 <- array(0, dim=c(S,T,max(L,M))) \\
for (l in 1:max(L,M)) \{ \\
\hspace*{0.27 in} A[, , l] <- exp(-D) \\
\hspace*{0.27 in} A[, , l] <- apply(A[, , l], 1, rank) \\
\hspace*{0.27 in} A[, , l] <- ifelse(A[, , l] > (l-1)*K \& A[, , l] <= l*K, 1, 0) \\
\hspace*{0.27 in} V[, , l] <- A[, , l] / rowSums(A[, , l]) \\
\hspace*{0.27 in} V[, , l] <- ifelse(is.nan(V[, , l]), 1/ncol(V[, , l]), V[, , l]) \\
\hspace*{0.27 in} W1[, , l] <- tcrossprod(V[, , l], t(Y))\} \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), phi=matrix(0,L,P), sigma=0, \\
\hspace*{0.27 in} theta=matrix(0,M,Q))) \\
pos.beta <- grep("beta", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
pos.theta <- grep("theta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} phi <- runif(Data$L*Data$P,-1,1) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} theta <- rnorm(Data$M*Data$Q) \\
\hspace*{0.27 in} return(c(beta, phi, sigma, theta)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, K=K, L=L, M=M, P=P, Q=Q, PGF=PGF, S=S, T=T, V=V, W1=W1, \\
\hspace*{0.27 in} X=X, Y=Y, latitude=latitude, longitude=longitude, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.phi=pos.phi, \\
\hspace*{0.27 in} pos.sigma=pos.sigma, pos.theta=pos.theta) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} phi <- matrix(interval(parm[Data$pos.phi], -1, 1), Data$L, Data$P) \\
\hspace*{0.27 in} parm[Data$pos.phi] <- as.vector(phi) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} theta <- matrix(parm[Data$pos.theta], Data$M, Data$Q) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} phi.prior <- sum(dunif(phi, -1, 1, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} theta.prior <- sum(dnormv(theta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- beta[1]*Data$X[, , 1] \\
\hspace*{0.27 in} for (j in 2:Data$J) mu <- mu + beta[j]*Data$X[, , j] \\
\hspace*{0.27 in} for (l in 1:Data$L) \{for (p in 1:Data$P) \{ \\
\hspace*{0.62 in} mu[,-c(1:p)] <- mu[,-c(1:p)] + \\
\hspace*{0.95 in} phi[l,p]*Data$W1[, 1:(Data$T - p), l]\}\} \\
\hspace*{0.27 in} epsilon <- Data$Y - mu \\
\hspace*{0.27 in} for (m in 1:Data$M) \{ \\
\hspace*{0.62 in} W2 <- tcrossprod(Data$V[, , m], t(epsilon)) \\
\hspace*{0.62 in} for (q in 1:Data$Q) \{ \\
\hspace*{0.95 in} mu[,-c(1:q)] <- mu[,-c(1:q)] + \\
\hspace*{0.95 in} theta[m,q]*W2[,1:(Data$T - q)]\}\} \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$Y[,-c(1:max(Data$P,Data$Q))], \\
\hspace*{0.62 in} mu[,-c(1:max(Data$P,Data$Q))], sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + phi.prior + sigma.prior + theta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), rep(0,L*P), 1, rep(0,M*Q))}

\section{State Space Model (SSM), Linear Regression} \label{ssm.lin.reg}
\subsection{Form}
$$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_{J+1}), \quad t=1,\dots,T$$
$$\mu = \textbf{X}\beta$$
$$\beta_{t,j} \sim \mathcal{N}(\mu_j + \phi_j(\beta_{t-1,j} - \mu_j), \sigma^2_j), \quad t=2,\dots,T, \quad j=1,\dots,J$$
$$\beta_{1,j} \sim \mathcal{N}(\mu_j + \phi_j(b^0_j - \mu_j), \sigma^2_j), \quad j=1,\dots,J$$
$$b^0_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\mu_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\phi_j \sim \mathcal{BETA}(20, 1.5) \quad j=1,\dots,J$$
$$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,(J+1)$$
\subsection{Data}
\code{data(demonfx) \\
y <- demonfx[1:50,1] \\
X <- cbind(1, as.matrix(demonfx[1:50,2:3])) \\
T <- nrow(X) \\
J <- ncol(X) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(b0=rep(0,J), beta=matrix(0,T,J), \\
\hspace*{0.27 in} mu=rep(0,J), phi=rep(0,J), sigma=rep(0,J+1))) \\
pos.b0 <- grep("b0", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.mu <- grep("mu", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} b0 <- rnorm(Data$J) \\
\hspace*{0.27 in} beta <- c(rnorm(Data$T,mean(Data$y),1), rnorm(Data$T*(Data$J-1))) \\
\hspace*{0.27 in} mu <- rnorm(Data$J) \\
\hspace*{0.27 in} phi <- runif(Data$J, -1, 1) \\
\hspace*{0.27 in} sigma <- runif(Data$J+1) \\
\hspace*{0.27 in} return(c(beta, mu, phi, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, T=T, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.b0=pos.b0, pos.beta=pos.beta, \\
\hspace*{0.27 in} pos.mu=pos.mu, pos.phi=pos.phi, pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} b0 <- parm[Data$pos.b0] \\
\hspace*{0.27 in} beta <- matrix(parm[Data$pos.beta], Data$T, Data$J) \\
\hspace*{0.27 in} mu <- parm[Data$pos.mu] \\
\hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], -1, 1) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} b0.prior <- sum(dnormv(b0, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} beta.prior <- sum(dnorm(beta, matrix(mu, Data$T, Data$J, byrow=TRUE) + \\
\hspace*{0.62 in} matrix(phi, Data$T, Data$J, byrow=TRUE) * \\
\hspace*{0.62 in} (rbind(b0, beta[-Data$T,]) - \\
\hspace*{0.62 in} matrix(mu, Data$T, Data$J, byrow=TRUE)), \\
\hspace*{0.62 in} matrix(sigma[1:Data$J], Data$T, Data$J, byrow=TRUE), log=TRUE)) \\
\hspace*{0.27 in} mu.prior <- sum(dnormv(mu, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} phi.prior <- sum(dbeta((phi+1)/2, 20, 1.5, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- rowSums(beta*Data$X) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma[Data$J+1], log=TRUE)) \\
\hspace*{0.27 in} yhat <- rnorm(length(mu), mu, sigma[Data$J+1]) \#Fitted \\
\hspace*{0.27 in} \#yhat <- rnorm(length(mu), rowSums(matrix(rnorm(Data$T*Data$J, \\
\hspace*{0.62 in} \# rbind(b0, beta[-Data$T,]), matrix(sigma[-Data$J], Data$T, Data$J, \\
\hspace*{0.62 in} \# byrow=TRUE)), Data$T, Data$J) * Data$X), sigma[Data$J+1]) \#One-step ahead \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + b0.prior + beta.prior + mu.prior + phi.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=yhat, parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), rep(mean(y),T), rep(0,T*(J-1)), rep(0,J), \\
\hspace*{0.27 in} rep(0,J), rep(1,J+1))}

\section{State Space Model (SSM), Local Level} \label{ssm.ll}
The local level model is the simplest, non-trivial example of a state space model (SSM). As such, this version of a local level SSM has static variance parameters.
\subsection{Form}
$$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_1), \quad t=1,\dots,T$$
$$\mu_t \sim \mathcal{N}(\mu_{t-1}, \sigma^2_2), \quad t=2,\dots,T$$
$$\mu_1 \sim \mathcal{N}(0, 1000)$$
$$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,2$$
\subsection{Data}
\code{T <- 20 \\
T.m <- 14 \\
mu.orig <- rep(0,T) \\
for (t in 2:T) \{mu.orig[t] <- mu.orig[t-1] + rnorm(1,0,1)\} \\
y <- mu.orig + rnorm(T,0,0.1) \\
y[(T.m+2):T] <- NA \\
mon.names <- rep(NA, (T-T.m)) \\
for (i in 1:(T-T.m)) mon.names[i] <- paste("yhat[",(T.m+i),"]", sep="") \\
parm.names <- as.parm.names(list(mu=rep(0,T), sigma=rep(0,2))) \\
pos.mu <- grep("mu", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} mu <- rnorm(Data$T) \\
\hspace*{0.27 in} sigma <- runif(2) \\
\hspace*{0.27 in} return(c(mu, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(PGF=PGF, T=T, T.m=T.m, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.mu=pos.mu, pos.sigma=pos.sigma, y=y) \\
Dyn <- matrix(paste("mu[",1:T,"]",sep=""), T, 1) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} mu <- parm[Data$pos.mu] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} mu.prior <- sum(dnormv(mu[1], 0, 1000, log=TRUE), \\
\hspace*{0.62 in} dnorm(mu[-1], mu[-Data$T], sigma[2], log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y[1:Data$T.m], mu[1:Data$T.m], sigma[1], \\
\hspace*{0.62 in} log=TRUE)) \\
\hspace*{0.27 in} yhat <- rnorm(length(mu), c(mu[1], rnorm(Data$T-1, mu[-Data$T], \\
\hspace*{0.62 in} sigma[2])), sigma[1]) \#One-step ahead
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + mu.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=mu[(Data$T.m+1):Data$T], \\
\hspace*{0.62 in} yhat=yhat, parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,T), rep(1,2))}

\section{State Space Model (SSM), Local Linear Trend} \label{ssm.llt}
The local linear trend model is a state space model (SSM) that extends the local level model to include a dynamic slope parameter. For more information on the local level model, see section \ref{ssm.ll}. This example has static variance parameters.
\subsection{Form}
$$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2_1), \quad t=1,\dots,T$$
$$\mu_t \sim \mathcal{N}(\mu_{t-1} + \delta_{t-1}, \sigma^2_2), \quad t=2,\dots,T$$
$$\mu_1 \sim \mathcal{N}(0, 1000)$$
$$\delta_t \sim \mathcal{N}(\delta_{t-1}, \sigma^2_3), \quad t=2,\dots,T$$
$$\delta_1 \sim \mathcal{N}(0, 1000)$$
$$\sigma_j \sim \mathcal{HC}(25), \quad j=1,\dots,3$$
\subsection{Data}
\code{T <- 20 \\
T.m <- 14 \\
mu.orig <- delta.orig <- rep(0,T) \\
for (t in 2:T) \{ \\
\hspace*{0.27 in} delta.orig[t] <- delta.orig[t-1] + rnorm(1,0,0.1) \\
\hspace*{0.27 in} mu.orig[t] <- mu.orig[t-1] + delta.orig[t-1] + rnorm(1,0,1)\} \\
y <- mu.orig + rnorm(T,0,0.1) \\
y[(T.m+2):T] <- NA \\
mon.names <- rep(NA, (T-T.m)) \\
for (i in 1:(T-T.m)) mon.names[i] <- paste("yhat[",(T.m+i),"]", sep="") \\
parm.names <- as.parm.names(list(mu=rep(0,T), delta=rep(0,T), \\
\hspace*{0.27 in} sigma=rep(0,3))) \\
pos.mu <- grep("mu", parm.names) \\
pos.delta <- grep("delta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} mu <- rnorm(Data$T) \\
\hspace*{0.27 in} delta <- rnorm(Data$T) \\
\hspace*{0.27 in} sigma <- runif(3) \\
\hspace*{0.27 in} return(c(mu, delta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(PGF=PGF, T=T, T.m=T.m, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.mu=pos.mu, pos.delta=pos.delta, \\
\hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} mu <- parm[Data$pos.mu] \\
\hspace*{0.27 in} delta <- parm[Data$pos.delta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} mu.prior <- sum(dnormv(mu[1], 0, 1000, log=TRUE), \\
\hspace*{0.62 in} dnorm(mu[-1], mu[-Data$T]+delta[-Data$T], sigma[2], \\
\hspace*{0.62 in} log=TRUE)) \\
\hspace*{0.27 in} delta.prior <- sum(dnormv(delta[1], 0, 1000, log=TRUE), \\
\hspace*{0.62 in} dnorm(delta[-1], delta[-Data$T], sigma[3], log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y[1:Data$T.m], mu[1:Data$T.m], sigma[1], \\
\hspace*{0.62 in} log=TRUE)) \\
\hspace*{0.27 in} yhat <- rnorm(length(mu), c(mu[1], rnorm(Data$T-1, mu[-Data$T], \\
\hspace*{0.62 in} sigma[2])), sigma[1]) \#One-step ahead \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + mu.prior + delta.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=mu[(Data$T.m+1):Data$T], \\
\hspace*{0.62 in} yhat=yhat, parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,T), rep(0,T), rep(1,3))}

\section{State Space Model (SSM), Stochastic Volatility (SV)} \label{sv}
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(0, \sigma^2)$$
$$\sigma^2 = \frac{1}{\exp(\theta)}$$
$$\beta = \exp(\mu / 2)$$
$$\theta_1 \sim \mathcal{N}(\mu + \phi (\alpha - \mu), \tau)$$
$$\theta_t \sim \mathcal{N}(\mu + \phi (\theta_{t-1} - \mu), \tau), \quad t=2,\dots,T$$
$$\alpha \sim \mathcal{N}(\mu, \tau)$$
$$\phi \sim \mathcal{U}(-1, 1)$$
$$\mu \sim \mathcal{N}(0, 10)$$
$$\tau \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{T <- 20 \\
y <- rep(10,T); epsilon <- rnorm(T,0,1) \\
for (t in 2:T) \{y[t] <- 0.8*y[t-1] + epsilon[t-1]\} \\
mon.names <- c("LP",paste("sigma2[",1:T,"]",sep="")) \\
parm.names <- as.parm.names(list(theta=rep(0,T), alpha=0, phi=0, mu=0, \\
\hspace*{0.27 in} tau=0)) \\
pos.theta <- grep("theta", parm.names) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.mu <- grep("mu", parm.names) \\
pos.tau <- grep("tau", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} phi <- runif(1,-1,1) \\
\hspace*{0.27 in} mu <- rnorm(1) \\
\hspace*{0.27 in} tau <- runif(1) \\
\hspace*{0.27 in} alpha <- rnorm(1, mu, tau) \\
\hspace*{0.27 in} theta <- rnorm(Data$T, mu + phi*(alpha - mu), tau) \\
\hspace*{0.27 in} return(c(theta, alpha, phi, mu, tau)) \\
\hspace*{0.27 in} \} \\
MyData <- list(PGF=PGF, T=T, mon.names=mon.names, parm.names=parm.names, 
\hspace*{0.27 in} pos.theta=pos.theta, pos.alpha=pos.alpha, pos.phi=pos.phi, \\
\hspace*{0.27 in} pos.mu=pos.mu, pos.tau=pos.tau y=y) \\
Dyn <- matrix(paste("theta[",1:T,"]",sep=""), T, 1) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} theta <- parm[Data$pos.theta] \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], -1, 1) \\
\hspace*{0.27 in} mu <- parm[Data$pos.mu] \\
\hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dnormv(alpha, mu, tau, log=TRUE) \\
\hspace*{0.27 in} theta.prior <- sum(dnormv(theta[1], mu + phi*(alpha-mu), tau, \\
\hspace*{0.62 in} log=TRUE), dnormv(theta[-1], mu + phi*(theta[-Data$T]-mu), tau, \\
\hspace*{0.62 in} log=TRUE)) \\
\hspace*{0.27 in} phi.prior <- dunif(phi, -1, 1, log=TRUE) \\
\hspace*{0.27 in} mu.prior <- dnormv(mu, 0, 10, log=TRUE) \\
\hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} beta <- exp(mu / 2) \\
\hspace*{0.27 in} sigma2 <- 1 / exp(theta) \\
\hspace*{0.27 in} LL <- sum(dnormv(Data$y, 0, sigma2, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + theta.prior + phi.prior + mu.prior + \\
\hspace*{0.62 in} tau.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, sigma2), \\
\hspace*{0.62 in} yhat=rnormv(length(Data$y), 0, sigma2), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,T), 0, 0, 0, 1)}

\section{Threshold Autoregression (TAR)} \label{tar}
\subsection{Form}
$$\textbf{y}_t \sim \mathcal{N}(\nu_t, \sigma^2), \quad t=1,\dots,T$$
\[\nu_t = \left\{
\begin{array}{l l}
  \alpha_1 + \phi_1 \textbf{y}_{t-1}, \quad t=1,\dots,T & \quad \mbox{if $t \ge \theta$}\\
  \alpha_2 + \phi_2 \textbf{y}_{t-1}, \quad t=1,\dots,T & \quad \mbox{if $t < \theta$} \\ \end{array} \right. \]
$$\alpha_j \sim \mathcal{N}(0, 1000) \in [-1,1], \quad j=1,\dots,2$$
$$\phi_j \sim \mathcal{N}(0, 1000), \in [-1,1], \quad j=1,\dots,2$$
$$\theta \sim \mathcal{U}(2, T-1)$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonfx) \\
y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\
T <- length(y) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=rep(0,2), phi=rep(0,2), theta=0, \\
\hspace*{0.27 in} sigma=0)) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.phi <- grep("phi", parm.names) \\
pos.theta <- grep("theta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rtrunc(2, "norm", a=-1, b=1, mean=0, sd=1) \\
\hspace*{0.27 in} phi <- rtrunc(2, "norm", a=-1, b=1, mean=0, sd=1) \\
\hspace*{0.27 in} theta <- runif(1,2,Data$T-1) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(alpha, phi, theta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(PGF=PGF, T=T, mon.names=mon.names, parm.names=parm.names, \\
\hspace*{0.27 in} pos.alpha=pos.alpha, pos.phi=pos.phi, pos.theta=pos.theta, \\
\hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} parm[Data$pos.alpha] <- alpha <- interval(parm[Data$pos.alpha], -1, 1) \\
\hspace*{0.27 in} parm[Data$pos.phi] <- phi <- interval(parm[Data$pos.phi], -1, 1) \\
\hspace*{0.27 in} theta <- interval(parm[Data$pos.theta], 2, Data$T-1) \\
\hspace*{0.27 in} parm[Data$pos.theta] <- theta \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- sum(dtrunc(alpha, "norm", a=-1, b=1, mean=0, \\
\hspace*{0.62 in} sd=sqrt(1000), log=TRUE)) \\
\hspace*{0.27 in} phi.prior <- sum(dtrunc(phi, "norm", a=-1, b=1, mean=0, \\
\hspace*{0.62 in} sd=sqrt(1000), log=TRUE)) \\
\hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} phi.prior <- sum(dnormv(phi, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} theta.prior <- dunif(theta, 2, Data$T-1, log=TRUE) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- matrix(0, Data$T, 2) \\
\hspace*{0.27 in} mu[,1] <- c(alpha[1], alpha[1] + phi[1]*Data$y[-Data$T]) \\
\hspace*{0.27 in} mu[,2] <- c(alpha[2], alpha[2] + phi[2]*Data$y[-Data$T]) \\
\hspace*{0.27 in} nu <- mu[,2]; temp <- which(1:Data$T < theta) \\
\hspace*{0.27 in} nu[temp] <- mu[temp,1] \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y[-1], nu[-1], sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + phi.prior + theta.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(nu), nu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,4), T/2, 1)}

\section{Time Varying AR(1) with Chebyshev Series} \label{tvarcs}
This example consists of a first-order autoregressive model, AR(1), with a time-varying parameter (TVP) $\phi$, that is a Chebyshev series constructed from a linear combination of orthonormal Chebyshev time polynomials (CTPs) and parameter vector $\beta$. The user creates basis matrix \textbf{P}, specifying polynomial degree $D$ and time $T$. Each column is a CTP of a different degree, and the first column is restricted to 1, the linear basis. CTPs are very flexible for TVPs, and estimate quickly because each is orthogonal, unlike simple polynomials and splines.
\subsection{Form}
$$\textbf{y}_t \sim \mathcal{N}(\mu_t, \sigma^2), \quad t=1,\dots,T$$
$$\mu_t = \alpha + \phi_{t-1} \textbf{y}_{t-1}$$
$$\phi_t = \textbf{P} \beta$$
$$\alpha \sim \mathcal{N}(0, 1000)$$
$$\beta_d \sim \mathcal{N}(0, 1000), \quad d=1,\dots,(D+1)$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonfx) \\
y <- as.vector(diff(log(as.matrix(demonfx[1:261,1])))) \\
D <- 6 \#Maximum degree of Chebyshev time polynomials \\
T <- length(y) \\
P <- matrix(1, T, D+1) \\
for (d in 1:D) \{P[,d+1] <- sqrt(2)*cos(d*pi*(c(1:T)-0.5)/T)\} \\
mon.names <- c("LP", "ynew", as.parm.names(list(phi=rep(0,T-1)))) \\
parm.names <- as.parm.names(list(alpha=0, beta=rep(0,D+1), sigma=0)) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(1) \\
\hspace*{0.27 in} beta <- rnorm(Data$D+1) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(alpha, beta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(D=D, P=P, PGF=PGF, T=T, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.beta=pos.beta, \\
\hspace*{0.27 in} pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- dnormv(alpha, 0, 1000, log=TRUE) \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} phi <- tcrossprod(Data$P[-Data$T,], t(beta)) \\
\hspace*{0.27 in} mu <- c(alpha, alpha + phi*Data$y[-Data$T]) \\
\hspace*{0.27 in} ynew <- rnorm(1, alpha + tcrossprod(Data$P[Data$T,], t(beta))* \\
\hspace*{0.62 in} Data$y[Data$T], sigma) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP,ynew,phi), \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,D+2), 1)}

\section{Variable Selection, BAL} \label{bal}
This approach to variable selection is one of several forms of the Bayesian Adaptive Lasso (BAL). The lasso applies shrinkage to exchangeable scale parameters, $\gamma$, for the regression effects, $\beta$.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu = \textbf{X}\beta$$
$$\beta_1 \sim \mathcal{L}(0, 1000)$$
$$\beta_j \sim \mathcal{L}(0, \gamma_j), \quad j=2,\dots,J$$
$$\gamma_j \sim \mathcal{G}^{-1}(\delta, \tau), \quad \in [0,\infty]$$
$$\delta \sim \mathcal{HC}(25)$$
$$\tau \sim \mathcal{HC}(25)$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonsnacks) \\
J <- ncol(demonsnacks) \\
y <- log(demonsnacks$Calories) \\
X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), gamma=rep(0,J-1), delta=0, \\
\hspace*{0.27 in} tau=0, sigma=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
pos.delta <- grep("delta", parm.names) \\
pos.tau <- grep("tau", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} delta <- runif(1) \\
\hspace*{0.27 in} tau <- runif(1) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} gamma <- rinvgamma(Data$J-1, delta, tau) \\
\hspace*{0.27 in} beta <- rlaplace(Data$J, 0, c(1,gamma)) \\
\hspace*{0.27 in} return(c(beta, gamma, delta, tau, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, \\
\hspace*{0.27 in} pos.delta=pos.delta, pos.tau=pos.tau, pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Hyperhyperparameters \\
\hspace*{0.27 in} delta <- interval(parm[Data$pos.delta], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.delta] <- delta \\
\hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\
\hspace*{0.27 in} \#\#\# Hyperparameters \\
\hspace*{0.27 in} gamma <- interval(parm[Data$pos.gamma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.gamma] <- gamma \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Hyperhyperprior \\
\hspace*{0.27 in} delta.prior <- dhalfcauchy(delta, 25, log=TRUE) \\
\hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Hyperprior \\
\hspace*{0.27 in} gamma.prior <- sum(dinvgamma(gamma, delta, tau, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dlaplace(beta, 0, c(1000, gamma), log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + gamma.prior + delta.prior + tau.prior + \\
\hspace*{0.62 in} sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), rep(0,J-1), rep(1,3))}

\section{Variable Selection, Horseshoe} \label{horseshoe}
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu = \textbf{X}\beta$$
$$\beta_1 \sim \mathcal{N}(0, 1000)$$
$$\beta_j \sim \mathcal{HS}(\lambda_j, \tau), \quad j=2,\dots,J$$
$$\lambda_j \sim \mathcal{HC}(1), \quad j=2,\dots,J$$
$$\tau \sim \mathcal{HC}(1)$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonsnacks) \\
J <- ncol(demonsnacks) \\
y <- log(demonsnacks$Calories) \\
X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), lambda=rep(0,J-1), \\
\hspace*{0.27 in} tau=0, sigma=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.lambda <- grep("lambda", parm.names) \\
pos.tau <- grep("tau", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} lambda <- runif(Data$J-1) \\
\hspace*{0.27 in} tau <- runif(1) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(beta, lambda, tau, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.lambda=pos.lambda, \\
\hspace*{0.27 in} pos.tau=pos.tau, pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} lambda <- interval(parm[Data$pos.lambda], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.lambda] <- lambda \\
\hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta[1], 0, 1000, log=TRUE), \\
\hspace*{0.62 in} dhs(beta[-1], lambda, tau, log=TRUE)) \\
\hspace*{0.27 in} lambda.prior <- sum(dhalfcauchy(lambda, 1, log=TRUE)) \\
\hspace*{0.27 in} tau.prior <- dhalfcauchy(tau, 1, log=TRUE) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), rep(1,J-1), rep(1,2))}

\section{Variable Selection, LASSO} \label{lasso}
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu = \textbf{X}\beta$$
$$\beta_1 \sim \mathcal{N}(0, 1000)$$
$$\beta_j \sim \mathcal{LASSO}(0, \sigma, \tau, \lambda_j), \quad j=2,\dots,J$$
\subsection{Data}
\code{data(demonsnacks) \\
J <- ncol(demonsnacks) \\
y <- log(demonsnacks$Calories) \\
X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0, tau=rep(0,J-1), \\
\hspace*{0.27 in} lambda=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
pos.tau <- grep("tau", parm.names) \\
pos.lambda <- grep("lambda", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} tau <- runif(Data$J-1) \\
\hspace*{0.27 in} lambda <- runif(1) \\
\hspace*{0.27 in} return(c(beta, sigma, tau, lambda)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, \\
\hspace*{0.27 in} pos.tau=pos.tau, pos.lambda=pos.lambda, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} parm[Data$pos.tau] <- tau <- interval(parm[Data$pos.tau], 1e-100, Inf) \\
\hspace*{0.27 in} lambda <- interval(parm[Data$pos.lambda], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.lambda] <- lambda \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta[1], 0, 1000, log=TRUE), \\
\hspace*{0.62 in} dlasso(beta[-1], sigma, tau, lambda, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 1, rep(1,J-1), 1)}

\section{Variable Selection, RJ} \label{rj}
This example uses the RJ (Reversible-Jump) algorithm of the \code{LaplacesDemon} function for variable selection and Bayesian Model Averaging (BMA). Other MCMC algorithms will not perform variable selection with this example, as presented. This is an example of variable selection in a linear regression. The only difference between the following example, and the example of linear regression (\ref{linear.reg}), is that RJ specifications are also included for the RJ algorithm, and that the RJ algorithm must be used.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu = \textbf{X}\beta$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{N <- 1000 \\
J <- 100 \#Number of predictors, including the intercept \\
X <- matrix(1,N,J) \\
for (j in 2:J) \{X[,j] <- rnorm(N,runif(1,-3,3),runif(1,0.1,1))\} \\
beta.orig <- runif(J,-3,3) \\
zero <- sample(2:J, round(J*0.9)) \#Assign most parameters to be zero \\
beta.orig[zero] <- 0 \\
e <- rnorm(N,0,0.1) \\
y <- as.vector(tcrossprod(beta.orig, X) + e) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(beta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, y=y) \\
\#\#\# Reversible-Jump Specifications
bin.n <- J-1 \#Maximum allowable model size \\
bin.p <- 0.4 \#Most probable size: bin.p x bin.n is binomial mean and median \\
parm.p <- rep(1/J,J+1) \\
selectable=c(0, rep(1,J-1), 0) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- GIV(Model, MyData, PGF=TRUE)}

\section{Variable Selection, SSVS} \label{ssvs}
This example uses a modified form of the random-effects (or global adaptation) Stochastic Search Variable Selection (SSVS) algorithm presented in \citet{ohara09}, which selects variables according to practical significance rather than statistical significance. Here, SSVS is applied to linear regression, though this method is widely applicable. For $J$ variables, each regression effect $\beta_j$ is conditional on $\gamma_j$, a binary inclusion variable. Each $\beta_j$ is a discrete mixture distribution with respect to $\gamma_j = 0$ or $\gamma_j = 1$, with precision 100 or $\beta_\sigma = 0.1$, respectively. As with other representations of SSVS, these precisions may require tuning.

The binary inclusion variables are discrete parameters, and discrete parameters are not supported in all algorithms. The example below is updated with the Slice sampler.

When the goal is to select the best model, each $\textbf{X}_{1:N,j}$ is retained for a future run when the posterior mean of $\gamma_j \ge 0.5$. When the goal is model-averaging, the results of this model may be used directly, which would please L. J. Savage, who said that ``models should be as big as an elephant'' \citep{draper95}.

\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu = \textbf{X} \beta$$
$$\beta_1 \sim \mathcal{N}(0, 1000)$$
$$(\beta_j | \gamma_j) \sim (1 - \gamma_j)\mathcal{N}(0, 0.01) + \gamma_j \mathcal{N}(0, \beta^2_\sigma) \quad j=2,\dots,J$$
$$\beta_\sigma \sim \mathcal{HC}(25)$$
$$\gamma_j \sim \mathcal{BERN}(1/(J-1)), \quad j=1,\dots,(J-1)$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonsnacks) \\
J <- ncol(demonsnacks) \\
y <- log(demonsnacks$Calories) \\
X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
mon.names <- c("LP", "min.beta.sigma") \\
parm.names <- as.parm.names(list(beta=rep(0,J), gamma=rep(0,J-1), \\
\hspace*{0.27 in} b.sd=0, sigma=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.gamma <- grep("gamma", parm.names) \\
pos.b.sd <- grep("b.sd", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} gamma <- rep(1,Data$J-1) \\
\hspace*{0.27 in} b.sd <- rnorm(1) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(beta, gamma, b.sd, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.gamma=pos.gamma, \\
\hspace*{0.27 in} pos.b.sd=pos.b.sd, pos.sigma=pos.sigma, y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Hyperparameters \\
\hspace*{0.27 in} beta.sigma <- interval(parm[Data$pos.b.sd], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.b.sd] <- beta.sigma \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} gamma <- parm[Data$pos.gamma] \\
\hspace*{0.27 in} beta.sigma <- rep(beta.sigma, Data$J-1) \\
\hspace*{0.27 in} beta.sigma[gamma == 0] <- 0.1 \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} \#\#\# Log-Hyperprior \\
\hspace*{0.27 in} beta.sigma.prior <- sum(dhalfcauchy(beta.sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnorm(beta, 0, c(sqrt(1000), beta.sigma, log=TRUE))) \\
\hspace*{0.27 in} gamma.prior <- sum(dbern(gamma, 1/(Data$J-1), log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta*c(1,gamma))) \\
\hspace*{0.27 in} LL <- sum(dnorm(y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + beta.sigma.prior + gamma.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=c(LP, min(beta.sigma)), \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), rep(1,J-1), rep(1,2))}

\section{VARMA(p,q) - SSVS} \label{varmapqssvs}
Stochastic search variable selection (SSVS) is applied to VARMA parameters. Note that the constants for the mixture variances are typically multiplied by the posterior standard deviations from an unrestricted VARMA that was updated previously, and these are not included in this example. Since an unrestricted VARMA model may be difficult to identify, this should be performed only on the AR parameters.
\subsection{Form}
$$\textbf{Y}_{t,j} \sim \mathcal{N}(\mu_{t,j}, \sigma^2_j), \quad t=1,\dots,T, \quad j=1,\dots,J$$
$$\mu_{t,j} = \alpha_j + \sum^P_{p=1} \Gamma^\Phi_{1:J,j,p}\Phi_{1:J,j,p}\textbf{Y}_{t-p,j} + \sum^Q_{q=1} \Gamma^\Theta_{1:J,j,q}\Theta_{1:J,j,q} \epsilon_{t-q,j}$$
$$\alpha_j \sim \mathcal{N}(0, 1000)$$
$$\Gamma^\Phi_{i,k,p} \sim \mathcal{BERN}(0.5), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$
$$(\Phi_{i,k,p} | \Gamma^\Phi_{i,k,p}) \sim (1 - \Gamma^\Phi_{i,k,p})\mathcal{N}(0, 0.01) + \Gamma^\Phi_{i,k,p}\mathcal{N}(0, 10), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$
$$\Gamma^\Theta_{i,k,q} \sim \mathcal{BERN}(0.5), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad q=1,\dots,Q$$
$$(\Theta_{i,k,q} | \Gamma^\Theta_{i,k,q}) \sim (1 - \Gamma^\Theta_{i,k,q})\mathcal{N}(0, 0.01) + \Gamma^\Theta_{i,k,q}\mathcal{N}(0, 10), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad q=1,\dots,Q$$
$$\sigma_j \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonfx) \\
Y.orig <- as.matrix(demonfx[,1:3]) \\
Y <- diff(log(Y.orig[1:100,])) \\
Y.scales <- sqrt(.colVars(Y)) \\
Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \\
T <- nrow(Y) \\
J <- ncol(Y) \\
L.P <- c(1,5,20) \#Autoregressive lags \\
L.Q <- c(1,2) \#Moving average lags \\
P <- length(L.P) \#Autoregressive order \\
Q <- length(L.Q) \#Moving average order \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=rep(0,J), \\
\hspace*{0.27 in} Gamma.phi=array(0, dim=c(J,J,P)), Phi=array(0, dim=c(J,J,P)), \\
\hspace*{0.27 in} Gamma.theta=array(0, dim=c(J,J,Q)), Theta=array(0, dim=c(J,J,Q)), \\
\hspace*{0.27 in} sigma=rep(0,J))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.Gamma.phi <- grep("Gamma.phi", parm.names) \\
pos.Phi <- grep("Phi", parm.names) \\
pos.Gamma.theta <- grep("Gamma.theta", parm.names) \\
pos.Theta <- grep("Theta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(Data$J) \\
\hspace*{0.27 in} Gamma.phi <- rep(1, Data$J*Data$J*Data$P) \\
\hspace*{0.27 in} Phi <- runif(Data$J*Data$J*Data$P, -1, 1) \\
\hspace*{0.27 in} Gamma.theta <- rep(1, Data$J*Data$J*Data$Q) \\
\hspace*{0.27 in} Theta <- rnorm(Data$J*Data$J*Data$Q) \\
\hspace*{0.27 in} sigma <- runif(Data$J) \\
\hspace*{0.27 in} return(c(alpha, Gamma.phi, Phi, Gamma.theta, Theta, sigma))
\hspace*{0.27 in} \} \\
MyData <- list(J=J, L.P=L.P, L.Q=L.Q, P=P, Q=Q, PGF=PGF, T=T, Y=Y, \\
\hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\
\hspace*{0.27 in} pos.Gamma.phi=pos.Gamma.phi, pos.Phi=pos.Phi, \\
\hspace*{0.27 in} pos.Gamma.theta=pos.Gamma.theta, pos.Theta=pos.Theta, \\
\hspace*{0.27 in} pos.sigma=pos.sigma) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} Gamma.phi <- array(parm[Data$pos.Gamma.phi], \\
\hspace*{0.62 in} dim=c(Data$J, Data$J, Data$P)) \\
\hspace*{0.27 in} Phi.Sigma <- Gamma.phi * 10 \\
\hspace*{0.27 in} Phi.Sigma[Gamma.phi == 0] <- 0.1 \\
\hspace*{0.27 in} Phi <- array(parm[Data$pos.Phi], dim=c(Data$J, Data$J, Data$P)) \\
\hspace*{0.27 in} Gamma.theta <- array(parm[Data$pos.Gamma.theta], \\
\hspace*{0.62 in} dim=c(Data$J, Data$J, Data$Q)) \\
\hspace*{0.27 in} Theta.Sigma <- Gamma.theta * 10 \\
\hspace*{0.27 in} Theta.Sigma[Gamma.theta == 0] <- 0.1 \\
\hspace*{0.27 in} Theta <- array(parm[Data$pos.Theta], dim=c(Data$J, Data$J, Data$Q)) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} Gamma.phi.prior <- sum(dbern(Gamma.phi, 0.5, log=TRUE)) \\
\hspace*{0.27 in} Phi.prior <- sum(dnorm(Phi, 0, Phi.Sigma, log=TRUE)) \\
\hspace*{0.27 in} Gamma.theta.prior <- sum(dbern(Gamma.theta, 0.5, log=TRUE)) \\
\hspace*{0.27 in} Theta.prior <- sum(dnorm(Theta, 0, Theta.Sigma, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- matrix(alpha, Data$T, Data$J, byrow=TRUE) \\
\hspace*{0.27 in} for (p in 1:Data$P) \\
\hspace*{0.62 in} mu[(1+Data$L.P[p]):Data$T,] <- mu[(1+Data$L.P[p]):Data$T,] + \\
\hspace*{0.95 in} Data$Y[1:(Data$T-Data$L.P[p]),] \%*\% \\
\hspace*{0.95 in} (Gamma.phi[, , p] * Phi[, , p]) \\
\hspace*{0.27 in} epsilon <- Data$Y - mu \\
\hspace*{0.27 in} for (q in 1:Data$Q) \\
\hspace*{0.62 in} mu[(1+Data$L.Q[q]):Data$T,] <- mu[(1+Data$L.Q[q]):Data$T,] + \\
\hspace*{0.95 in} epsilon[1:(Data$T-Data$L.Q[q]),] \%*\% \\
\hspace*{0.95 in} (Gamma.theta[, , q] * Theta[, , q]) \\
\hspace*{0.27 in} Sigma <- matrix(sigma, Data$T, Data$J, byrow=TRUE) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$Y[(1+Data$L.P[Data$P]):Data$T,], \\
\hspace*{0.62 in} mu[(1+Data$L.P[Data$P]):Data$T,], \\
\hspace*{0.62 in} Sigma[(1+Data$L.P[Data$P]):Data$T,], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + Gamma.phi.prior + Phi.prior + \\
\hspace*{0.27 in} Gamma.theta.prior + Theta.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(colMeans(Y), rep(1,J*J*P), runif(J*J*P,-1,1), \\
\hspace*{0.27 in} rep(1,J*J*Q), rep(0,J*J*Q), rep(1,J))}

\section{VAR(p)-GARCH(1,1)-M} \label{varpgarchm}
The Minnesota prior is applied to the VAR parameters, and the multivariate GARCH component is estimated with asymmetric BEKK. Compared to VAR(p) or VARMA(p,q), this is computationally intensive. However, it also tends to result in a substantial improvement when time for computation is feasible. This model also performs well when SSVS is applied to all parameters except \textbf{C}, though it is even more computationally intensive, and is not shown here.
\subsection{Form}
$$\textbf{Y}_{t,1:J} \sim \mathcal{N}_J(\mu_{t,1:J}, H_{1:J,1:J,t})$$
$$\mu_{t,j} = \alpha_j + \sum^P_{p=1} \Phi_{1:J,j,p} \textbf{Y}_{t-p,j} + \sum \textbf{H}_{1:J,j,t-1} \delta_{1:J,j}$$
$$\textbf{H}_{,,t} = \Omega + \textbf{A}^T \epsilon_{t-1,}\epsilon^T_{t-1} \textbf{A} + \textbf{B}^T \textbf{H}_{,,t-1}\textbf{B} + \textbf{D}^T\zeta_{t-1,}\zeta^T_{t-1,}\textbf{D}, \quad t=2,\dots,T$$
$$\Omega = \textbf{C}\textbf{C}^T$$
$$\alpha_j \sim \mathcal{N}(0, 1000)$$
$$\delta_{i,k} \sim \mathcal{N}(0, 1000), \quad i=1,\dots,J, \quad k=1,\dots,J$$
$$\Phi_{i,k,p} \sim \mathcal{N}(\Phi^\mu_{i,k,p}, \Sigma_{i,k,p}), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$
$$\textbf{C}_{i,j} \sim \mathcal{N}(0, 100)$$
$$\textbf{A}_{i,j} \sim \mathcal{N}(0, 100)$$
$$\textbf{B}_{i,j} \sim \mathcal{N}(0, 100)$$
$$\textbf{D}_{i,j} \sim \mathcal{N}(0, 100)$$
where $\Phi$ has a Minnesota prior, \textbf{C} is lower-triangular with positive-only diagonal elements, and $\textbf{A}_{1,1}$, $\textbf{B}_{1,1}$, and $\textbf{D}_{1,1}$ must be positive.
\subsection{Data}
\code{data(demonfx) \\
Y.orig <- as.matrix(demonfx[,1:3]) \\
Y <- diff(log(Y.orig[1:100,])) \\
Y.scales <- sqrt(.colVars(Y)) \\
Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \\
T <- nrow(Y) \\
J <- ncol(Y) \\
L <- c(1,5,20) \#Autoregressive lags \\
P <- length(L) \#Autoregressive order \\
Phi.mu <- array(0, dim=c(J,J,P)) \\
Phi.mu[, , 1] <- diag(J) \\
C <- matrix(NA, J, J) \\
C[lower.tri(C, diag=TRUE)] <- 0 \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=rep(0,J), delta=matrix(0,J,J), \\
\hspace*{0.27 in} Phi=array(0, dim=c(J,J,P)), C=C, A=matrix(0,J,J), B=matrix(0,J,J), \\
\hspace*{0.27 in} D=matrix(0,J,J))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.delta <- grep("delta", parm.names) \\
pos.Phi <- grep("Phi", parm.names) \\
pos.C <- grep("C", parm.names) \\
pos.A <- grep("A", parm.names) \\
pos.B <- grep("B", parm.names) \\
pos.D <- grep("D", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(Data$J) \\
\hspace*{0.27 in} delta <- rnorm(Data$J*Data$J) \\
\hspace*{0.27 in} Phi <- runif(Data$J*Data$J*Data$P, -1, 1) \\
\hspace*{0.27 in} C <- runif(Data$J*(Data$J+1)/2) \\
\hspace*{0.27 in} A <- as.vector(diag(Data$J)) + runif(Data$J*Data$J, -0.1, 0.1) \\
\hspace*{0.27 in} B <- as.vector(diag(Data$J)) + runif(Data$J*Data$J, -0.1, 0.1) \\
\hspace*{0.27 in} D <- as.vector(diag(Data$J)) + runif(Data$J*Data$J, -0.1, 0.1) \\
\hspace*{0.27 in} return(c(alpha, delta, Phi, C, A, B, D)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, L=L, P=P, PGF=PGF, Phi.mu=Phi.mu, T=T, Y=Y, \\
\hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\
\hspace*{0.27 in} pos.delta=pos.delta, pos.Phi=pos.Phi, pos.C=pos.C, pos.A=pos.A, \\
\hspace*{0.27 in} pos.B=pos.B, pos.D=pos.D) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} delta <- matrix(parm[Data$pos.delta], Data$J, Data$J) \\
\hspace*{0.27 in} Phi <- array(parm[Data$pos.Phi], dim=c(Data$J, Data$J, Data$P)) \\
\hspace*{0.27 in} C <- matrix(0, Data$J, Data$J) \\
\hspace*{0.27 in} C[lower.tri(C, diag=TRUE)] <- parm[Data$pos.C] \\
\hspace*{0.27 in} diag(C) <- abs(diag(C)) \\
\hspace*{0.27 in} parm[Data$pos.C] <- C[lower.tri(C, diag=TRUE)] \\
\hspace*{0.27 in} Omega <- C \%*\% t(C) \\
\hspace*{0.27 in} A <- matrix(parm[Data$pos.A], Data$J, Data$J) \\
\hspace*{0.27 in} A[1,1] <- abs(A[1,1]) \\
\hspace*{0.27 in} parm[Data$pos.A] <- as.vector(A) \\
\hspace*{0.27 in} B <- matrix(parm[Data$pos.B], Data$J, Data$J) \\
\hspace*{0.27 in} B[1,1] <- abs(B[1,1]) \\
\hspace*{0.27 in} parm[Data$pos.B] <- as.vector(B) \\
\hspace*{0.27 in} D <- matrix(parm[Data$pos.D], Data$J, Data$J) \\
\hspace*{0.27 in} D[1,1] <- abs(D[1,1]) \\
\hspace*{0.27 in} parm[Data$pos.D] <- as.vector(D) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} delta.prior <- sum(dnormv(delta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} Sigma <- MinnesotaPrior(Data$J, lags=Data$L, lambda=1, \\
\hspace*{0.62 in} theta=0.5, sqrt(diag(Omega))) \\
\hspace*{0.27 in} Phi.prior <- sum(dnormv(Phi, Data$Phi.mu, Sigma, log=TRUE)) \\
\hspace*{0.27 in} C.prior <- sum(dnormv(C[lower.tri(C, diag=TRUE)], 0, 100, log=TRUE)) \\
\hspace*{0.27 in} A.prior <- sum(dnormv(A, 0, 100, log=TRUE)) \\
\hspace*{0.27 in} B.prior <- sum(dnormv(B, 0, 100, log=TRUE)) \\
\hspace*{0.27 in} D.prior <- sum(dnormv(D, 0, 100, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- matrix(alpha, Data$T, Data$J, byrow=TRUE) \\
\hspace*{0.27 in} for (p in 1:Data$P) \\
\hspace*{0.62 in} mu[(1+Data$L[p]):Data$T,] <- mu[(1+Data$L[p]):Data$T,] + \\
\hspace*{0.95 in} Data$Y[1:(Data$T-Data$L[p]),] \%*\% Phi[, , p] \\
\hspace*{0.27 in} LL <- 0 \\
\hspace*{0.27 in} Yhat <- Data$Y \\
\hspace*{0.27 in} H <- array(Omega, dim=c(Data$J, Data$J, Data$T)) \\
\hspace*{0.27 in} for (t in 2:Data$T) \{ \\
\hspace*{0.62 in} eps <- Data$Y - mu \\
\hspace*{0.62 in} zeta <- matrix(interval(eps, -Inf, 0, reflect=FALSE), Data$T, \\
\hspace*{0.95 in} Data$J) \\
\hspace*{0.62 in} part1 <- t(A) \%*\% eps[t-1,] \%*\% t(eps[t-1,]) \%*\% A \\
\hspace*{0.62 in} part2 <- t(B) \%*\% H[, , t-1] \%*\% B \\
\hspace*{0.62 in} part3 <- t(D) \%*\% zeta[t-1,] \%*\% t(zeta[t-1,]) \%*\% D \\
\hspace*{0.62 in} H0 <- Omega + part1 + part2 + part3 \\
\hspace*{0.62 in} H0[upper.tri(H0, diag=TRUE)] <- t(H0)[upper.tri(H0, diag=TRUE)] \\
\hspace*{0.62 in} H[, , t] <- H0 \\
\hspace*{0.62 in} mu[t-1,] <- mu[t-1,] + colMeans(H[, , t-1]*delta) \\
\hspace*{0.62 in} Sigma <- MinnesotaPrior(Data$J, lags=Data$L, lambda=1, \\
\hspace*{0.95 in} theta=0.5, sqrt(diag(H[, , t]))) \\
\hspace*{0.62 in} Phi.prior <- Phi.prior + sum(dnormv(Phi, Data$Phi.mu, Sigma, \\
\hspace*{0.95 in} log=TRUE)) \\
\hspace*{0.62 in} LL <- LL + dmvn(Y[t,], mu[t,], H[, , t], log=TRUE) \\
\hspace*{0.62 in} Yhat[t,] <- rmvn(1, mu[t,], H[, , t]) \\
\hspace*{0.62 in} \} \\
\hspace*{0.27 in} Phi.prior <- Phi.prior / Data$T \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + delta.prior + Phi.prior + C.prior + \\
\hspace*{0.62 in} A.prior + B.prior + D.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, yhat=Yhat, parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(colMeans(Y), rnorm(J*J), runif(J*J*P,-1,1), \\
\hspace*{0.27 in} runif(J*(J+1)/2), as.vector(diag(J)), as.vector(diag(J)), \\
\hspace*{0.27 in} as.vector(diag(J)))}

\section{VAR(p) - Minnesota Prior} \label{varp}
This is an example of a vector autoregression or VAR with $P$ lags that uses the Minnesota prior to estimate $\Sigma$.
\subsection{Form}
$$\textbf{Y}_{t,j} \sim \mathcal{N}(\mu_{t,j}, \sigma^2_j), \quad t=1,\dots,T, \quad j=1,\dots,J$$
$$\mu_{t,j} = \alpha_j + \sum^P_{p=1} \Phi_{1:J,j,p} \textbf{Y}_{t-p,j}$$
$$\textbf{y}^{new}_j = \alpha_j + \Phi_{1:J,j} \textbf{Y}_{T,j}$$
$$\alpha_j \sim \mathcal{N}(0, 1000)$$
$$\Phi_{i,k,p} \sim \mathcal{N}(\Phi^\mu_{i,k,p}, \Sigma_{i,k,p}), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$
$$\sigma_j \sim \mathcal{HC}(25)$$
where $\Phi^\mu$ and $\Sigma$ are set according to the Minnesota prior.
\subsection{Data}
\code{data(demonfx) \\
Y.orig <- as.matrix(demonfx[,1:3]) \\
Y <- diff(log(Y.orig[1:100,])) \\
Y.scales <- sqrt(.colVars(Y)) \\
Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \\
T <- nrow(Y) \\
J <- ncol(Y) \\
L <- c(1,5,20) \#Autoregressive lags \\
P <- length(L) \#Autoregressive order \\
Phi.mu <- array(0, dim=c(J,J,P)) \\
Phi.mu[, , 1] <- diag(J) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=rep(0,J), \\
\hspace*{0.27 in} Phi=array(0, dim=c(J,J,P)), sigma=rep(0,J))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.Phi <- grep("Phi", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(Data$J) \\
\hspace*{0.27 in} Phi <- runif(Data$J*Data$J*Data$P, -1, 1) \\
\hspace*{0.27 in} sigma <- runif(Data$J) \\
\hspace*{0.27 in} return(c(alpha, Phi, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, L=L, P=P, PGF=PGF, Phi.mu=Phi.mu, T=T, Y=Y, \\
\hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\
\hspace*{0.27 in} pos.Phi=pos.Phi, pos.sigma=pos.sigma) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} Phi <- array(parm[Data$pos.Phi], dim=c(Data$J, Data$J, Data$P)) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} Sigma <- MinnesotaPrior(Data$J, lags=Data$L, lambda=1, theta=0.5, \\
\hspace*{0.62 in} sigma) \\
\hspace*{0.27 in} Phi.prior <- sum(dnormv(Phi, Data$Phi.mu, Sigma, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- matrix(alpha, Data$T, Data$J, byrow=TRUE) \\
\hspace*{0.27 in} for (p in 1:Data$P) \{ \\
\hspace*{0.62 in} mu[(1+Data$L[p]):Data$T,] <- mu[(1+Data$L[p]):Data$T,] + \\
\hspace*{0.62 in} Data$Y[1:(Data$T-Data$L[p]),] \%*\% Phi[ , , p]\} \\
\hspace*{0.27 in} Sigma <- matrix(sigma, Data$T, Data$J, byrow=TRUE) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$Y[(1+Data$L[Data$P]):Data$T,], \\
\hspace*{0.62 in} mu[(1+Data$L[Data$P]):Data$T,], \\
\hspace*{0.62 in} Sigma[(1+Data$L[Data$P]):Data$T,], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + Phi.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(as.vector(colMeans(Y)), rep(0,J*J*P), rep(1,J))}

\section{VAR(p) - SSVS} \label{varpsvss}
Stochastic search variable selection (SSVS) is applied to VAR autoregressive parameters. Note that the constants for the mixture variances are typically multiplied by the posterior standard deviations from an unrestricted VAR that was updated previously, and these are not included in this example.
\subsection{Form}
$$\textbf{Y}_{t,j} \sim \mathcal{N}(\mu_{t,j}, \sigma^2_j), \quad t=1,\dots,T, \quad j=1,\dots,J$$
$$\mu_{t,j} = \alpha_j + \sum^P_{p=1} \Gamma_{1:J,j,p}\Phi_{1:J,j,p}\textbf{Y}_{t-p,j}$$
$$\alpha_j \sim \mathcal{N}(0, 1000)$$
$$\Gamma_{i,k,p} \sim \mathcal{BERN}(0.5), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$
$$(\Phi_{i,k,p} | \Gamma_{i,k,p}) \sim (1 - \Gamma_{i,k,p})\mathcal{N}(0, 0.01) + \Gamma_{i,k,p}\mathcal{N}(0, 10), \quad i=1,\dots,J, \quad k=1,\dots,J, \quad p=1,\dots,P$$
$$\sigma_j \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonfx) \\
Y.orig <- as.matrix(demonfx[,1:3]) \\
Y <- diff(log(Y.orig[1:100,])) \\
Y.scales <- sqrt(.colVars(Y)) \\
Y <- Y / matrix(Y.scales, nrow(Y), ncol(Y), byrow=TRUE) \\
T <- nrow(Y) \\
J <- ncol(Y) \\
L <- c(1,5,20) \#Autoregressive lags \\
P <- length(L) \#Autoregressive order \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=rep(0,J), \\
     Gamma=array(0, dim=c(J,J,P)), Phi=array(0, dim=c(J,J,P)), \\
     sigma=rep(0,J))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.Gamma <- grep("Gamma", parm.names) \\
pos.Phi <- grep("Phi", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(Data$J) \\
\hspace*{0.27 in} Gamma <- rep(1, Data$J*Data$J*Data$P) \\
\hspace*{0.27 in} Phi <- runif(Data$J*Data$J*Data$P, -1, 1) \\
\hspace*{0.27 in} sigma <- runif(Data$J) \\
\hspace*{0.27 in} return(c(alpha, Gamma, Phi, sigma)) \\
\hspace*{0.27 in} \}
MyData <- list(J=J, L=L, P=P, PGF=PGF, T=T, Y=Y, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.alpha=pos.alpha, pos.Gamma=pos.Gamma, \\
\hspace*{0.27 in} pos.Phi=pos.Phi, pos.sigma=pos.sigma) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} alpha <- parm[Data$pos.alpha] \\
\hspace*{0.27 in} Gamma <- array(parm[Data$pos.Gamma], dim=c(Data$J, Data$J, Data$P)) \\
\hspace*{0.27 in} Phi.Sigma <- Gamma * 10 \\
\hspace*{0.27 in} Phi.Sigma[Gamma == 0] <- 0.1 \\
\hspace*{0.27 in} Phi <- array(parm[Data$pos.Phi], dim=c(Data$J, Data$J, Data$P)) \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} Gamma.prior <- sum(dbern(Gamma, 0.5, log=TRUE)) \\
\hspace*{0.27 in} Phi.prior <- sum(dnorm(Phi, 0, Phi.Sigma, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- sum(dhalfcauchy(sigma, 25, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- matrix(alpha, Data$T, Data$J, byrow=TRUE) \\
\hspace*{0.27 in} for (p in 1:Data$P) \\
\hspace*{0.62 in} mu[(1+Data$L[p]):Data$T,] <- mu[(1+Data$L[p]):Data$T,] + \\
\hspace*{0.62 in} Data$Y[1:(Data$T-Data$L[p]),] \%*\% (Gamma[, , p]*Phi[, , p]) \\
\hspace*{0.27 in} Sigma <- matrix(sigma, Data$T, Data$J, byrow=TRUE) \\
\hspace*{0.27 in} LL <- sum(dnorm(Data$Y[(1+Data$L[Data$P]):Data$T,], \\
\hspace*{0.62 in} mu[(1+Data$L[Data$P]):Data$T,], \\
\hspace*{0.62 in} Sigma[(1+Data$L[Data$P]):Data$T,], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + Gamma.prior + Phi.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(prod(dim(mu)), mu, Sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(colMeans(Y), rep(1,J*J*P), runif(J*J*P,-1,1), rep(1,J))}

\section{Weighted Regression} \label{weighted.reg}
It is easy enough to apply record-level weights to the likelihood. Here, weights are applied to the linear regression example in section \ref{linear.reg}.
\subsection{Form}
$$\textbf{y} \sim \mathcal{N}(\mu, \sigma^2)$$
$$\mu = \textbf{X}\beta$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J$$
$$\sigma \sim \mathcal{HC}(25)$$
\subsection{Data}
\code{data(demonsnacks) \\
N <- nrow(demonsnacks) \\
J <- ncol(demonsnacks) \\
y <- log(demonsnacks$Calories) \\
X <- cbind(1, as.matrix(demonsnacks[,c(1,3:10)])) \\
for (j in 2:J) X[,j] <- CenterScale(X[,j]) \\
w <- c(rep(1,5), 0.2, 1, 0.01, rep(1,31)) \\
w <- w * (sum(w) / N) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(beta=rep(0,J), sigma=0)) \\
pos.beta <- grep("beta", parm.names) \\
pos.sigma <- grep("sigma", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} beta <- rnorm(Data$J) \\
\hspace*{0.27 in} sigma <- runif(1) \\
\hspace*{0.27 in} return(c(beta, sigma)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J=J, PGF=PGF, X=X, mon.names=mon.names, \\
\hspace*{0.27 in} parm.names=parm.names, pos.beta=pos.beta, pos.sigma=pos.sigma, w=w, \\
\hspace*{0.27 in} y=y) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} beta <- parm[Data$pos.beta] \\
\hspace*{0.27 in} sigma <- interval(parm[Data$pos.sigma], 1e-100, Inf) \\
\hspace*{0.27 in} parm[Data$pos.sigma] <- sigma \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 1000, log=TRUE)) \\
\hspace*{0.27 in} sigma.prior <- dhalfcauchy(sigma, 25, log=TRUE) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} mu <- tcrossprod(Data$X, t(beta)) \\
\hspace*{0.27 in} LL <- sum(w * dnorm(Data$y, mu, sigma, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + beta.prior + sigma.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rnorm(length(mu), mu, sigma), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- c(rep(0,J), 1)}

\section{Zero-Inflated Poisson (ZIP)} \label{zip}
\subsection{Form}
$$\textbf{y} \sim \mathcal{P}(\Lambda_{1:N,2})$$
$$\textbf{z} \sim \mathcal{BERN}(\Lambda_{1:N,1})$$
\[\textbf{z}_i = \left\{ 
\begin{array}{l l}
  1 & \quad \mbox{if $\textbf{y}_i = 0$}\\
  0 \\ \end{array} \right. \]
\[\Lambda_{i,2} = \left\{ 
\begin{array}{l l}
  0 & \quad \mbox{if $\Lambda_{i,1} \ge 0.5$}\\
  \Lambda_{i,2} \\ \end{array} \right. \]
$$\Lambda_{1:N,1} = \frac{1}{1 + \exp(-\textbf{X}_1 \alpha)}$$
$$\Lambda_{1:N,2} = \exp(\textbf{X}_2 \beta)$$
$$\alpha_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J_1$$
$$\beta_j \sim \mathcal{N}(0, 1000), \quad j=1,\dots,J_2$$
\subsection{Data}
\code{N <- 1000 \\
J1 <- 4 \\
J2 <- 3 \\
X1 <- matrix(runif(N*J1,-2,2),N,J1); X1[,1] <- 1 \\
X2 <- matrix(runif(N*J2,-2,2),N,J2); X2[,1] <- 1 \\
alpha <- runif(J1,-1,1) \\
beta <- runif(J2,-1,1) \\
p <- invlogit(tcrossprod(X1, t(alpha)) + rnorm(N,0,0.1)) \\
mu <- round(exp(tcrossprod(X2, t(beta)) + rnorm(N,0,0.1))) \\
y <- ifelse(p > 0.5, 0, mu) \\
z <- ifelse(y == 0, 1, 0) \\
mon.names <- "LP" \\
parm.names <- as.parm.names(list(alpha=rep(0,J1), beta=rep(0,J2))) \\
pos.alpha <- grep("alpha", parm.names) \\
pos.beta <- grep("beta", parm.names) \\
PGF <- function(Data) \{ \\
\hspace*{0.27 in} alpha <- rnorm(Data$J1) \\
\hspace*{0.27 in} beta <- rnorm(Data$J2) \\
\hspace*{0.27 in} return(c(alpha, beta)) \\
\hspace*{0.27 in} \} \\
MyData <- list(J1=J1, J2=J2, N=N, PGF=PGF, X1=X1, X2=X2, \\
\hspace*{0.27 in} mon.names=mon.names, parm.names=parm.names, pos.alpha=pos.alpha, \\
\hspace*{0.27 in} pos.beta=pos.beta, y=y, z=z) \\
}
\subsection{Model}
\code{Model <- function(parm, Data) \\
\hspace*{0.27 in} \{ \\
\hspace*{0.27 in} \#\#\# Parameters \\
\hspace*{0.27 in} parm[Data$pos.alpha] <- alpha <- interval(parm[Data$pos.alpha], -5, 5) \\
\hspace*{0.27 in} parm[Data$pos.beta] <- beta <- interval(parm[Data$pos.beta], -5, 5) \\
\hspace*{0.27 in} \#\#\# Log-Prior \\
\hspace*{0.27 in} alpha.prior <- sum(dnormv(alpha, 0, 5, log=TRUE)) \\
\hspace*{0.27 in} beta.prior <- sum(dnormv(beta, 0, 5, log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Likelihood \\
\hspace*{0.27 in} Lambda <- matrix(NA, Data$N, 2) \\
\hspace*{0.27 in} Lambda[,1] <- invlogit(tcrossprod(Data$X1, t(alpha))) \\
\hspace*{0.27 in} Lambda[,2] <- exp(tcrossprod(Data$X2, t(beta))) + 1e-100 \\
\hspace*{0.27 in} Lambda[which(Lambda[,1] >= 0.5),2] <- 0 \\
\hspace*{0.27 in} LL <- sum(dbern(Data$z, Lambda[,1], log=TRUE), \\
\hspace*{0.62 in} dpois(Data$y, Lambda[,2], log=TRUE)) \\
\hspace*{0.27 in} \#\#\# Log-Posterior \\
\hspace*{0.27 in} LP <- LL + alpha.prior + beta.prior \\
\hspace*{0.27 in} Modelout <- list(LP=LP, Dev=-2*LL, Monitor=LP, \\
\hspace*{0.62 in} yhat=rpois(nrow(Lambda), Lambda[,2]), parm=parm) \\
\hspace*{0.27 in} return(Modelout) \\
\hspace*{0.27 in} \} \\
}
\subsection{Initial Values}
\code{Initial.Values <- GIV(Model, MyData, n=10000)}

\bibliography{References}

\end{document}