Factor Models
In this tutorial, we will cover a more advanced use-case of AdaptEllipticalSliceSampler.JL, where we use AGESS[1] to sample a subset of parameters, and use Gibbs sampling to conditionally update the rest of the samplers. In this tutorial, we consider the following factor model using the multiplicative gamma process shrinkage prior[2]:
\[\mathbf{y}_i = \Lambda \eta_i + \epsilon_i,\]
\[\epsilon_i \sim \mathcal{N}(0, \mathbf{D}),\]
\[\Lambda_{jh} \mid \phi_{jh}, \tau_h \sim \mathcal{N}(0, \phi_{jh}^{-1} \tau_h^{-1}),\]
\[\phi_{jh} \sim \text{Gamma}(\nu / 2, \nu / 2),\]
\[\tau_h = \prod_{k=1}^h \delta_k \;\;\; (h = 1, \dots, K)\]
\[\delta_1 \sim \text{Gamma}(a_1, 1),\]
\[\delta_{h} \sim \text{Gamma}(a_2, 1) \;\;\; (h \ge 2),\]
\[\mathbf{D}_{jj} \sim \text{Inv-Gamma}(a, b),\]
where $\mathbf{y}_i \in \mathbb{R}^P$, $\Lambda \in \mathbb{R}^{P \times K}$, $\eta_i \in \mathbb{R}^{K}$, $\mathbf{D}$ is a Diagonal matrix, and $a_2 > 1$ (to promote shrinkage). In these settings, it is often the case that $K$ is much smaller than $P$. Under this setup, a Gibbs sampler is available[2], making sampling relatively straightforward. Consider the case where we want to use AGESS to sample $\Lambda$, $\eta_i$, and $\mathbf{D}$, while using Gibbs updates for $\delta_h$ and $\phi_{jh}$. We will start by constructing Gibbs samplers for $\delta_h$ and $\phi_{jh}$.
Gibbs Updates
The conditional posterior distribution of $\delta_h$ and $\phi_{jh}$ are as follows[2]:
\[\phi_{jh}\mid \Theta_{-\phi_{jh}} \sim \text{Gamma}\left(0.5(\nu + 1), 0.5(\nu + \tau_h \Lambda_{jh}^2)\right)\]
\[\delta_1 \mid \Theta_{-\delta_1} \sim \text{Gamma}\left(a_1 + 0.5(P\times K), 1 + 0.5\left(\sum_{l=1}^K \tau_{l}^{(-1)} \sum_{j=1}^P \phi_{jl}\Lambda_{jl}^2\right)\right)\]
\[\delta_h \mid \Theta_{-\delta_h} \sim \text{Gamma}\left(a_2 + 0.5(P\times (K - h +1)), 1 + 0.5\left(\sum_{l=h}^K \tau_{l}^{(-h)} \sum_{j=1}^P \phi_{jl}\Lambda_{jl}^2\right)\right)\;\;\; (2 \le h \le K)\]
We can construct Julia functions to update these parameters as follows.
using Random, BenchmarkTools
using AdaptEllipticalSliceSampler
using Distributions
using Plots
using LinearAlgebra
Random.seed!(123)
function delta_sampler!(δ::AbstractVector{Y}, ϕ::AbstractMatrix{Y}, Λ::AbstractMatrix{Y},
a1_δ::Y, a2_δ::Y, ph_δ::AbstractVector{Y}) where {Y<:AbstractFloat}
K = length(δ)
P = size(Λ)[2]
## Sample δ1
α = a1_δ + 0.5 * K * P
@views ph_δ .= ϕ[1,:] .* Λ[1,:]
@views β = 1.0 + 0.5 * dot(ph_δ, Λ[1,:])
for i in 2:K
@views τ = prod(δ[2:i])
@views ph_δ .= ϕ[i,:] .* Λ[i,:]
@views β += 0.5 * τ * dot(ph_δ, Λ[i,:])
end
δ[1] = rand(Gamma(α, 1 / β))
## Sample rest of δ
for i in 2:K
α = a2_δ + 0.5 * (K - i + 1) * P
β = 1.0
@views τ = prod(δ[1:(i-1)])
for j in i:K
if i != j
τ *= δ[j]
end
@views ph_δ .= ϕ[j,:] .* Λ[j,:]
@views β += 0.5 * τ * dot(ph_δ, Λ[j,:])
end
δ[i] = rand(Gamma(α, 1 / β))
end
return nothing
end
function phi_sampler!(ϕ::AbstractMatrix{Y}, δ::AbstractVector{Y}, Λ::AbstractMatrix{Y},
ν::Y) where {Y<:AbstractFloat}
K = length(δ)
P = size(Λ)[2]
for i in 1:K
@views τ = prod(δ[1:i])
for j in 1:P
α = (ν + 1) * 0.5
β = 0.5 * (ν + τ * Λ[i,j]^2)
ϕ[i,j] = rand(Gamma(α, 1 / β))
end
end
return nothing
endphi_sampler! (generic function with 1 method)AGESS Updates
Now that we have our functions to update the $\phi$ and $\tau$ parameters via Gibbs updates, we can write a function that evaluates the conditional posterior of the rest of the parameters so that we can update the state of the Markov chain for these parameters via AGESS[1]. Here we will construct two functions. The first one evaluates the likelihood, and the second one reshapes and makes necessary transformations to our variables of interest.
function posterior(Λ::AbstractMatrix{Y}, η::AbstractMatrix{Y}, Y_obs::AbstractMatrix{Y},
D::AbstractMatrix{Y}, ϕ::AbstractMatrix{Y}, δ::AbstractVector{Y},
τ_ph::AbstractVector{Y}, a::Y, b::Y,
ph::AbstractVector{Y}, ph1::AbstractVector{Y})::Float64 where {Y<:AbstractFloat}
lpdf::Float64 = 0.0
## Likelihood
for i in 1:size(Y_obs)[1]
@views mul!(ph, Λ', η[i,:])
@views ph .-= Y_obs[i,:]
@views ph1 .= ph ./ D[diagind(D)]
@views lpdf += (-0.5* sum(log.(D[diagind(D)])) - 0.5 * dot(ph1, ph))
end
ig_d = InverseGamma(a,b)
for i in 1:size(D)[1]
lpdf += logpdf(ig_d, D[i,i])
end
τ_ph .= δ
for i in 2:length(δ)
τ_ph[i] *= τ_ph[i-1]
end
for i in 1:size(Λ)[1], j in 1:size(Λ)[2]
lpdf += 0.5 * log(ϕ[i,j] * τ_ph[i]) - 0.5 * (Λ[i,j]^2 * ϕ[i,j] * τ_ph[i])
end
for i in 1:size(η)[1]
@views lpdf += - 0.5 * dot(η[i,:], η[i,:])
end
return lpdf
end
function transform_posterior(x::AbstractVector{Y}, Y_obs::AbstractMatrix{Y},
ϕ::AbstractMatrix{Y}, δ::AbstractVector{Y},
τ_ph::AbstractVector{Y}, a::Y, b::Y,
N::T, P::T, K::T, D_ph::AbstractMatrix{Y},
ph::AbstractVector{Y},
ph1::AbstractVector{Y})::Float64 where {Y<:AbstractFloat, T<:Integer}
@views Λ_ph = reshape(x[1:K*P], (K, P))
@views η_ph = reshape(x[(K*P + 1):(N*K + K*P)], (N, K))
@views D_ph[diagind(D_ph)] .= exp.(x[(N*K + K*P + 1):(N*K + K*P + P)])
lpdf = posterior(Λ_ph, η_ph, Y_obs, D_ph, ϕ, δ, τ_ph, a, b, ph, ph1)
### Jacobian for transformation
@views lpdf += sum(x[(N*K + K*P + 1):(N*K + K*P + P)])
return lpdf
endtransform_posterior (generic function with 1 method)Construct Custom MCMC Sampling Scheme
Now that we have set up the functions necessary to use the AdaptEllipticalSliceSampler.jl package, and have constructed the functions necessary to perform Gibbs updates, we can use the following two functions to create a custom MCMC sampling method: AGESS_single_step_1d! and AGESS_single_step!. Here we will use a t-distribution with 6 degrees of freedom as our marginal distribution of the auxiliary variable in AGESS.
function custom_MCMC(Y_obs::AbstractMatrix{Y}, K::T, n_MCMC::T, a_1::Y, a_2::Y, a::Y, b::Y,
ϵ::Y, single_step_prop::Y, burnin::Y, ν::Y, β::Y) where {Y<:AbstractFloat, T<:Integer}
N = size(Y_obs)[1]
P = size(Y_obs)[2]
n_params = (N * K) + (K * P) + P
### Set up variables
x = zeros(n_MCMC, n_params)
ϕ = ones(n_MCMC, K, P)
δ = ones(n_MCMC, K)
## Allocate variables for AGESS
ph_AGESS = zeros(n_params)
z = similar(ph_AGESS)
w_const = max(2/3, ((cbrt(n_params) - 1) / cbrt(n_params)))
N_J = 2
n_j = 2
ph_cholesky_update = ones(n_params)
perm = randperm(n_params)
### Allocate variables for intermediate calculations
τ_ph = zeros(K)
D_ph = diagm(ones(P))
ph = zeros(P)
ph1 = similar(ph)
ph_δ = similar(ph)
### Setup adaptive parameters
μ_adapt = zeros(n_params)
μ_adapt_ph = zeros(n_params)
μ_0 = zeros(n_params)
Σ_adapt = diagm(ones(n_params))
Σ_chol_0 = cholesky(Σ_adapt)
Σ_chol_adapt = deepcopy(Σ_chol_0)
Σ_chol_adapt_ph = deepcopy(Σ_chol_0)
### variable for storing log posterior pdf
lpdf = zeros(n_MCMC)
@views lpdf[1] = transform_posterior(x[1,:], Y_obs, ϕ[1,:,:], δ[1,:], τ_ph, a,
b, N, P, K, D_ph, ph, ph1)
### Start MCMC
for i in 2:n_MCMC
### AGESS update
if i < (n_MCMC * burnin)
### 1-d AGESS updates for fast burn-in
@views lpdf[i] = AGESS_single_step_1d!(x, y -> transform_posterior(y, Y_obs,
ϕ[i,:,:], δ[i,:], τ_ph, a,
b, N, P, K, D_ph, ph, ph1), true, 6.0,
n_params, μ_adapt,
Σ_chol_adapt.L, lpdf[i-1], perm, i)
else
if rand() > (ϵ + single_step_prop)
### standard AGESS step
@views lpdf[i] = AGESS_single_step!(x, z, y -> transform_posterior(y, Y_obs,
ϕ[i,:,:], δ[i,:], τ_ph, a,
b, N, P, K, D_ph, ph, ph1), true, 6.0,
n_params, ph_AGESS, μ_adapt,
Σ_chol_adapt.L, lpdf[i-1], i)
elseif rand() < (single_step_prop / (ϵ + single_step_prop))
### AGESS updates with only 1-d updates
@views lpdf[i] = AGESS_single_step_1d!(x, y -> transform_posterior(y, Y_obs,
ϕ[i,:,:], δ[i,:], τ_ph, a,
b, N, P, K, D_ph, ph, ph1), true, 6.0,
n_params, μ_adapt,
Σ_chol_adapt.L, lpdf[i-1], perm, i)
else
### Non-adaptive update
@views lpdf[i] = AGESS_single_step!(x, z, y -> transform_posterior(y, Y_obs,
ϕ[i,:,:], δ[i,:], τ_ph, a,
b, N, P, K, D_ph, ph, ph1), true, 6.0,
n_params, ph_AGESS, μ_0,
Σ_chol_0.L, lpdf[i-1], i)
end
end
### Update variables
@views Λ_ph = reshape(x[i, 1:K*P], (K, P))
@views η_ph = reshape(x[(K*P + 1):(N*K + K*P)], (N, K))
@views D_ph[diagind(D_ph)] .= exp.(x[(N*K + K*P + 1):(N*K + K*P + P)])
### Gibbs Updates
@views phi_sampler!(ϕ[i,:,:], δ[i,:], Λ_ph, ν)
@views delta_sampler!(δ[i,:], ϕ[i,:,:], Λ_ph, a_1, a_2, ph_δ)
### Update Adaptive Scheme
w_i = i^(-w_const)
Σ_chol_adapt_ph.U .= sqrt((1 - w_i)) .* Σ_chol_adapt_ph.U
@views ph_cholesky_update .= sqrt(w_i) .* (x[i,:] .- μ_adapt_ph)
lowrankupdate!(Σ_chol_adapt_ph, ph_cholesky_update)
@views μ_adapt_ph .= (1 - w_i) * μ_adapt_ph + w_i * x[i,:]
## Adapt mean and covariance according to AIRMCMC
if i == N_J
Σ_chol_adapt.U .= Σ_chol_adapt_ph.U
@views μ_adapt .= μ_adapt_ph
n_j += 1
N_J += floor(n_j^β)
end
### Update next state
if i < n_MCMC
@views x[i+1,:] .= x[i,:]
@views ϕ[i+1,:,:] .= ϕ[i,:,:]
@views δ[i+1,:] .= δ[i,:]
end
### rerun evaluation of posterior density after gibbs updates
@views lpdf[i] = transform_posterior(x[i,:], Y_obs, ϕ[i,:,:], δ[i,:], τ_ph, a, b, N,
P, K, D_ph, ph, ph1)
### Print statement
if (i % 100) == 0
@views println("MCMC iter: ", i, " lpdf = ", mean(lpdf[i-99:i]))
end
end
Λ_out = zeros(n_MCMC, K, P)
η_out = zeros(n_MCMC, N, K)
D_out = zeros(n_MCMC, P, P)
for i in 1:n_MCMC
@views Λ_out[i,:,:] .= reshape(x[i, 1:K*P], (K, P))
@views η_out[i,:,:] .= reshape(x[i, (K*P + 1):(N*K + K*P)], (N, K))
for j in 1:P
D_out[i,j,j] = exp(x[i, (N*K + K*P + j)])
end
end
return Λ_out, η_out, D_out, ϕ, δ
endcustom_MCMC (generic function with 1 method)We have constructed our custom MCMC sampler. We can now generate some synthetic data and test the performance of our sampler.
### Generate Data
K = 4
N = 200
P = 50
Σ = diagm(ones(P))
ph = zeros(P)
for i in 1:(K - 3)
ph = randn(P)
Σ .+= i .* (ph * ph')
end
μ_0 = zeros(P)
Y_obs = rand(MvNormal(μ_0, Σ), N)'
Σ_truth = deepcopy(Σ)
### Run custom MCMC
a_1 = 2.0
a_2 = 2.0
ν = 2.0
a = 1.0
b = 1.0
n_MCMC = 10000
ϵ = 0.05
single_step_prop = 0.05
β = 0.5
burnin = 0.01
@time Λ_samp, η_samp, D_samp, ϕ_samp, δ_samp = custom_MCMC(Y_obs, K, n_MCMC, a_1, a_2, a,
b, ϵ, single_step_prop, burnin,
ν, β)([0.0 0.0 0.0 0.0; -0.11261588545665198 0.005249971151925579 0.16775604813056266 -0.2601908318136752; … ; -0.47837353334514104 0.14741277070885248 -0.13752651672205268 -0.7408121921811346; -0.47878697592096475 0.14775483731918368 -0.138376282989759 -0.7413694684735556;;; 0.0 0.0 0.0 0.0; 0.6272518604464292 0.36343229606252503 0.06412071321084413 0.6000425306736885; … ; 0.6618873973367415 0.16649804006632207 -0.19895723326924492 0.9332041479288787; 0.6626230992191371 0.16641821131918552 -0.19787325187540905 0.932903236649856;;; 0.0 0.0 0.0 0.0; 0.0680130629945553 -0.11246160396480917 0.027213053442416955 0.22777614980501207; … ; 0.7986125595645266 0.14200420566155622 0.23203119105560302 0.7036986050720185; 0.7985216417599373 0.1432277290418959 0.23412380554845008 0.704969056428551;;; … ;;; 0.0 0.0 0.0 0.0; 0.02861140268179307 0.353416922916414 -0.06599431726184798 -0.4184013550528051; … ; 0.782336302633174 0.4492253317795494 -0.38879821066788667 0.29242733480725525; 0.783931558089811 0.44925757304307085 -0.38846200122125335 0.29226238326235787;;; 0.0 0.0 0.0 0.0; 0.8642754204290692 0.2744885939793009 0.10595661971511568 -0.2496774645556675; … ; 0.39065632168938524 0.8196303750413487 -0.05381090123950191 0.857751098634858; 0.39317296105352423 0.8176001231396638 -0.05377801610151978 0.8573616861805338;;; 0.0 0.0 0.0 0.0; -0.17035259647226972 -0.6638863805273516 -0.1857441113331592 0.05076548849259288; … ; -0.7571764251174881 -0.18675544332501795 -0.24411346368303521 -0.17581299917129056; -0.7543951551447288 -0.18817335778474742 -0.24380122838283694 -0.17492368350111046], [0.0 0.0 … 0.0 0.0; -0.3918981093771017 -0.13943981267369437 … 0.1379751099496585 0.5078759087300582; … ; -0.5019726974094667 -1.0288573247087998 … 0.6785312209990895 0.7273370068068472; -0.49959219554990636 -1.0286293670642994 … 0.679815910835456 0.7275292080485443;;; 0.0 0.0 … 0.0 0.0; -0.466693301250591 -0.5980263234805476 … 1.2670680943774508 -0.0013491549191727691; … ; -0.00679754106982914 -0.5515830733992092 … 0.6755895546151083 0.150286871022434; -0.007456751861760163 -0.551762425201797 … 0.6788055781474728 0.14909319971316418;;; 0.0 0.0 … 0.0 0.0; -0.01421572823299255 0.04973088706271119 … -0.12319684678942582 -0.06214306411839359; … ; -0.01194230185987705 0.3852382953947743 … 0.3624350319481542 -0.1307455959347738; -0.011009638780695663 0.38507351801243045 … 0.3596630692182321 -0.13047631353276737;;; 0.0 0.0 … 0.0 0.0; -0.16390860705757668 -0.14852177707320424 … 0.008741964249883457 -0.2907388315004424; … ; -0.43042794553658575 -0.5743629592312821 … 0.8880590416844739 -0.5474500051676148; -0.43019271393386976 -0.5772901473467956 … 0.888819135070369 -0.547378166009212], [1.0 0.0 … 0.0 0.0; 1.3138343896288092 0.0 … 0.0 0.0; … ; 1.1575286493071566 0.0 … 0.0 0.0; 1.1558589401470092 0.0 … 0.0 0.0;;; 0.0 1.0 … 0.0 0.0; 0.0 1.0438001917752935 … 0.0 0.0; … ; 0.0 0.9956156831374865 … 0.0 0.0; 0.0 0.9953878484010152 … 0.0 0.0;;; 0.0 0.0 … 0.0 0.0; 0.0 0.0 … 0.0 0.0; … ; 0.0 0.0 … 0.0 0.0; 0.0 0.0 … 0.0 0.0;;; … ;;; 0.0 0.0 … 0.0 0.0; 0.0 0.0 … 0.0 0.0; … ; 0.0 0.0 … 0.0 0.0; 0.0 0.0 … 0.0 0.0;;; 0.0 0.0 … 1.0 0.0; 0.0 0.0 … 2.041801106997551 0.0; … ; 0.0 0.0 … 1.0622098627602792 0.0; 0.0 0.0 … 1.0648977474798418 0.0;;; 0.0 0.0 … 0.0 1.0; 0.0 0.0 … 0.0 2.3308495889248704; … ; 0.0 0.0 … 0.0 1.0691863474064196; 0.0 0.0 … 0.0 1.0703406684455066], [1.0 1.0 1.0 1.0; 1.4538454644862804 1.4275743897916318 2.682847573938428 1.4883058539256195; … ; 0.5738550775992599 0.8815999100793224 0.15799864905536706 1.4253436781979612; 0.7694886587256188 2.3718776289186505 3.425807117732776 0.8572308838964832;;; 1.0 1.0 1.0 1.0; 1.2092593835693817 1.2936214327427986 0.9179504741479844 1.010729065181896; … ; 0.6582368563863008 2.5759592399299467 0.46034318220286874 1.160070807414693; 0.6774017625216485 0.11576996827076397 0.5566495847404883 0.13412892011848923;;; 1.0 1.0 1.0 1.0; 0.42463508672627126 3.0146916516943443 0.4904968513458115 1.1479821699368187; … ; 0.9516849979611969 0.8247757416567425 0.4426860415949478 0.10402745765323182; 1.112685084259856 0.36608842363640753 0.6467145122680287 1.7025739794808508;;; … ;;; 1.0 1.0 1.0 1.0; 2.1831111037715294 1.1692777245747563 0.5319885506188426 1.1673298160364258; … ; 0.4773097697807921 0.912727951502717 1.4657661299589027 1.8339145448154104; 2.7628662317481543 1.3728888973418696 0.45811020290972887 0.31045958991245837;;; 1.0 1.0 1.0 1.0; 1.0285802810213867 1.358044976682831 4.6766873822972785 0.35855623559499056; … ; 2.327986390013402 0.07018704874812848 0.2551714258701247 1.2294632644955072; 0.9481555919098231 0.3472998821239347 0.8374624392948274 0.42612432054629734;;; 1.0 1.0 1.0 1.0; 1.2990048864736647 1.206255639326305 0.13752134626669116 2.0222701427875616; … ; 0.39233742786068526 0.25433006968397104 1.1456899603961896 0.33058201023562084; 0.697572131563558 0.3534529639677483 0.573325655452813 0.8409766302063405], [1.0 1.0 1.0 1.0; 4.882202470960154 1.5066751132266865 1.0132269540305536 0.8771241198653181; … ; 3.5738801534364364 3.2135532547317305 3.369343674305427 0.08961476451089917; 2.993787991654477 4.665606746495214 2.5679636248956 0.06538468818374187])We can look at estimates of $\Lambda'\Lambda + \mathbf{D}$ to see how well we recovered the covariance structure. First, we will look at the true covariance matrix.
heatmap(Σ_truth)
Now, we can look at the posterior element-wise mean of $\Lambda'\Lambda + \mathbf{D}$.
function posterior_Σ(Λ_samp::AbstractArray{Y,3}, D_samp::AbstractArray{Y,3}, P::T;
burnin = 0.5) where {Y<:AbstractFloat, T<:Integer}
n_MCMC = size(Λ_samp)[1]
burnin_num = floor(Int64, burnin * n_MCMC)
posterior_samps = zeros(n_MCMC - burnin_num, P, P)
for i in (burnin_num +1):n_MCMC
@views posterior_samps[i - burnin_num,:,:] .= Λ_samp[i,:,:]' * Λ_samp[i,:,:]
posterior_samps[i - burnin_num,:,:] .+= D_samp[i,:,:]
end
return posterior_samps
end
Σ_samp = posterior_Σ(Λ_samp, D_samp, P, burnin = 0.5)
Σ_mean = zeros(P,P)
for i in 1:P
for j in 1:P
Σ_mean[i,j] = mean(Σ_samp[:,i,j])
end
end
heatmap(Σ_mean)
We can also look at the trace plots of individual elements of $\Lambda'\Lambda + \mathbf{D}$, along with the true value (represented by the horizontal line).
plot(Σ_samp[:,1,1])
hline!([Σ_truth[1,1]])
Conclusion
As illustrated in this tutorial, the AdaptEllipticalSliceSampler.jl package can be used to construct custom MCMC schemes. When considering factor analysis in this setting, one may notice that we can simply use AGESS for sampling all parameters. Although this tutorial primarily serves as a guide for how to construct custom MCMC sampling schemes, we can compare the results obtained when using AGESS to sample all parameters.
function posterior2(Λ::AbstractMatrix{Y}, η::AbstractMatrix{Y}, Y_obs::AbstractMatrix{Y},
D::AbstractMatrix{Y}, ϕ::AbstractMatrix{Y}, δ::AbstractVector{Y},
τ_ph::AbstractVector{Y}, a_1::Y, a_2::Y, ν::Y, a::Y, b::Y,
ph::AbstractVector{Y}, ph1::AbstractVector{Y})::Float64 where {Y<:AbstractFloat}
lpdf::Float64 = 0.0
## Likelihood
for i in 1:size(Y_obs)[1]
@views mul!(ph, Λ', η[i,:])
@views ph .-= Y_obs[i,:]
@views ph1 .= ph ./ D[diagind(D)]
@views lpdf += (-0.5* sum(log.(D[diagind(D)])) - 0.5 * dot(ph1, ph))
end
##Priors
for i in eachindex(δ)
if i == 1
lpdf += logpdf(Gamma(a_1, 1), exp(δ[1])) + δ[1]
else
lpdf += logpdf(Gamma(a_2, 1), exp(δ[i])) + δ[i]
end
end
ig_d = InverseGamma(a,b)
for i in 1:size(D)[1]
lpdf += logpdf(ig_d, D[i,i]) + log(D[i,i])
end
τ_ph .= exp.(δ)
for i in 2:length(δ)
τ_ph[i] *= τ_ph[i-1]
end
gamma_d = Gamma(0.5 * ν, 2 / ν)
for i in 1:size(Λ)[1], j in 1:size(Λ)[2]
lpdf += 0.5 * log(exp(ϕ[i,j]) * τ_ph[i]) - 0.5 * (Λ[i,j]^2 * exp(ϕ[i,j]) * τ_ph[i])
lpdf += logpdf(gamma_d, exp(ϕ[i,j])) + ϕ[i,j]
end
for i in 1:size(η)[1]
@views lpdf += - 0.5 * dot(η[i,:], η[i,:])
end
return lpdf
end
function transform_posterior2(x::AbstractVector{Y}, Y_obs::AbstractMatrix{Y},
δ_ph::AbstractVector{Y}, τ_ph::AbstractVector{Y},
a_1::Y, a_2::Y, ν::Y, a::Y, b::Y,
N::T, P::T, K::T, D_ph::AbstractMatrix{Y},
ph::AbstractVector{Y},
ph1::AbstractVector{Y})::Float64 where {Y<:AbstractFloat, T<:Integer}
@views Λ_ph = reshape(x[1:K*P], (K, P))
@views η_ph = reshape(x[(K*P + 1):(N*K + K*P)], (N, K))
@views D_ph[diagind(D_ph)] .= exp.(x[(N*K + K*P + 1):(N*K + K*P + P)])
@views ϕ_ph = reshape(x[(N*K + K*P + P + 1):(N*K + 2*K*P + P)], (K, P))
@views δ_ph .= x[(N*K + 2*K*P + P + 1):(N*K + 2*K*P + P + K)]
lpdf = posterior2(Λ_ph, η_ph, Y_obs, D_ph, ϕ_ph, δ_ph, τ_ph, a_1, a_2, ν, a, b, ph, ph1)
return lpdf
endtransform_posterior2 (generic function with 1 method)Now that we have specified a function evaluating the posterior log pdf, we can call the function AGESS.
# Set variables
τ_ph = zeros(K)
δ_ph = zeros(K)
D_ph = zeros(P,P)
ph = zeros(P)
ph1 = similar(ph)
n_params = N*K + 2*K*P + P + K
results = AGESS(x -> transform_posterior2(x, Y_obs, δ_ph, τ_ph, a_1, a_2, ν, a, b, N, P, K,
D_ph, ph, ph1), n_MCMC, n_params)AdaptEllipticalSliceSampler.MCMC_output([0.0 0.0 … 0.0 0.0; -0.43065264858604724 0.12389865198690232 … 0.4034177716876439 -0.15914288288687442; … ; -0.3047840834660329 -0.437303392172106 … 0.38168489403328837 -0.8767973544541902; -0.30488941347484483 -0.43747364882834444 … 0.38165380466229737 -0.8767515985795032], [-9792.603397906596, -7726.336233723766, -6849.226703702453, -6274.567580506464, -5934.757641962127, -5832.48164667897, -5747.620801721175, -5698.669186667384, -5609.2753344062485, -5561.010747446548 … -4998.009021008173, -4998.317680309517, -4999.013509905071, -4998.861432427294, -4998.601540801511, -4999.199104639748, -4998.9200559315095, -4998.681408026886, -4998.246179067439, -4998.151222782084], AGESS_MCMC_params(Main.var"#7#8"(), [0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 … 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0], [1.0 0.0 … 0.0 0.0; 0.0 1.0 … 0.0 0.0; … ; 0.0 0.0 … 1.0 0.0; 0.0 0.0 … 0.0 1.0], true, 6.0, 0.5, 0.05, 0.5, 0.05, 10000, 1254), [0.0025366550824784707 -9.838165253706332e-5 … -6.482639483649915e-6 -5.102847123245859e-5; -9.838165253706332e-5 0.001679686560227984 … 9.243397589922295e-6 -0.0001237820748711212; … ; -6.482639483649915e-6 9.243397589922295e-6 … 0.000486747520196574 -4.835504777845237e-5; -5.102847123245859e-5 -0.0001237820748711212 … -4.835504777845237e-5 0.0005016575776250575], [-0.369660219312629, -0.31565747189271914, -0.3986292876116623, -0.3760652143364196, 0.652413062666151, 0.44222381879412914, 0.6020073016986787, 0.3970015136457125, 0.475060009611022, 0.5489646167425544 … 0.24540710373202043, -0.9498564245473966, -0.4916184851081174, 0.03587274254842667, 0.018209055497401743, 0.058951325971652306, 1.1977389089849535, 0.9407767100753789, 0.3662812400292673, -0.9214111676815305])We can extract the parameters using the following code.
Λ_samp2 = zeros(n_MCMC, K, P)
η_samp2 = zeros(n_MCMC, N, K)
D_samp2 = zeros(n_MCMC, P, P)
δ_samp2 = zeros(n_MCMC, K)
ϕ_samp2 = zeros(n_MCMC, K, P)
for i in 1:n_MCMC
@views Λ_samp2[i,:,:] .= reshape(results.samps[i, 1:K*P], (K, P))
@views η_samp2[i,:,:] .= reshape(results.samps[i, (K*P + 1):(N*K + K*P)], (N, K))
for j in 1:P
D_samp2[i,j,j] = exp(results.samps[i, (N*K + K*P + j)])
end
@views ϕ_samp2[i,:,:] .= reshape(exp.(results.samps[i, (N*K + K*P + P + 1):(N*K + 2*K*P + P)]), (K, P))
@views δ_samp2[i,:] .= exp.(results.samps[i, (N*K + 2*K*P + P + 1):(N*K + 2*K*P + P + K)])
endSimilarly to before, we can look at the posterior element-wise mean of $\Lambda'\Lambda + \mathbf{D}$.
Σ_samp2 = posterior_Σ(Λ_samp2, D_samp2, P, burnin = 0.5)
Σ_mean2 = zeros(P,P)
for i in 1:P
for j in 1:P
Σ_mean2[i,j] = mean(Σ_samp2[:,i,j])
end
end
heatmap(Σ_mean2)
Lastly, we can look at the trace plots of individual elements of $\Lambda'\Lambda + \mathbf{D}$, along with the true value (represented by the horizontal line).
plot(Σ_samp2[:,1,1])
hline!([Σ_truth[1,1]])