Outcome prediction using JAGS from R - r

[Code is updated and does not correspond to error messages anymore]
I am trying to understand how JAGS predicts outcome values (for a mixed markov model). I've trained the model on a dataset which includes outcome m and covariates x1, x2 and x3.
Predicting the outcome without fixing parameter values works in R, but the output seems completely random:
preds <- run.jags("model.txt",
data=list(x1=x1, x2=x2, x3=x3, m=m,
statealpha=rep(1,times=M), M=M, T=T, N=N), monitor=c("m_pred"),
n.chains=1, inits = NA, sample=1)
Compiling rjags model...
Calling the simulation using the rjags method...
Note: the model did not require adaptation
Burning in the model for 4000 iterations...
|**************************************************| 100%
Running the model for 1 iterations...
Simulation complete
Finished running the simulation
However, as soon as I try to fix parameters (i.e. use model estimates to predict outcome m, I get errors:
preds <- run.jags("model.txt",
data=list(x1=x1, x2=x2, x3=x3,
statealpha=rep(1,times=M), M=M, T=T, N=N, beta1=beta1), monitor=c("m"),
n.chains=1, inits = NA, sample=1)
Compiling rjags model...
Error: The following error occured when compiling and adapting the model using rjags:
Error in rjags::jags.model(model, data = dataenv, n.chains = length(runjags.object$end.state), :
RUNTIME ERROR:
Compilation error on line 39.
beta1[2,1] is a logical node and cannot be observed
beta1 in this case is a 2x2 matrix of coefficient estimates.
How is JAGS predicting m in the first example (no fixed parameters)? Is it just completely randomly choosing m?
How can I include earlier acquired model estimates to simulate new outcome values?
The model is:
model{
for (i in 1:N)
{
for (t in 1:T)
{
m[t,i] ~ dcat(ps[i,t,])
}
for (state in 1:M)
{
ps[i,1,state] <- probs1[state]
for (t in 2:T)
{
ps[i,t,state] <- probs[m[(t-1),i], state, i,t]
}
for (prev in 1:M){
for (t in 1:T) {
probs[prev,state,i,t] <- odds[prev,state,i,t]/totalodds[prev,i,t]
odds[prev,state,i,t] <- exp(alpha[prev,state,i] +
beta1[prev,state]*x1[t,i]
+ beta2[prev,state]*x2[t,i]
+ beta3[prev,state]*x3[t,i])
}}
alpha[state,state,i] <- 0
for (t in 1:T) {
totalodds[state,i,t] <- odds[state,1,i,t] + odds[state,2,i,t]
}
}
alpha[1,2,i] <- raneffs[i,1]
alpha[2,1,i] <- raneffs[i,2]
raneffs[i,1:2] ~ dmnorm(alpha.means[1:2],alpha.prec[1:2, 1:2])
}
for (state in 1:M)
{
beta1[state,state] <- 0
beta2[state,state] <- 0
beta3[state,state] <- 0
}
beta1[1,2] <- rcoeff[1]
beta1[2,1] <- rcoeff[2]
beta2[1,2] <- rcoeff[3]
beta2[2,1] <- rcoeff[4]
beta3[1,2] <- rcoeff[5]
beta3[2,1] <- rcoeff[6]
alpha.Sigma[1:2,1:2] <- inverse(alpha.prec[1:2,1:2])
probs1[1:M] ~ ddirich(statealpha[1:M])
for (par in 1:6)
{
alpha.means[par] ~ dt(T.constant.mu,T.constant.tau,T.constant.k)
rcoeff[par] ~ dt(T.mu, T.tau, T.k)
}
T.constant.mu <- 0
T.mu <- 0
T.constant.tau <- 1/T.constant.scale.squared
T.tau <- 1/T.scale.squared
T.constant.scale.squared <- T.constant.scale*T.constant.scale
T.scale.squared <- T.scale*T.scale
T.scale <- 2.5
T.constant.scale <- 10
T.constant.k <- 1
T.k <- 1
alpha.prec[1:2,1:2] ~ dwish(Om[1:2,1:2],2)
Om[1,1] <- 1
Om[1,2] <- 0
Om[2,1] <- 0
Om[2,2] <- 1
## Prediction
for (i in 1:N)
{
m_pred[1,i] <- m[1,i]
for (t in 2:T)
{
m_pred[t,i] ~ dcat(ps_pred[i,t,])
}
for (state in 1:M)
{
ps_pred[i,1,state] <- probs1[state]
for (t in 2:T)
{
ps_pred[i,t,state] <- probs_pred[m_pred[(t-1),i], state, i,t]
}
for (prev in 1:M)
{
for (t in 1:T)
{
probs_pred[prev,state,i,t] <- odds_pred[prev,state,i,t]/totalodds_pred[prev,i,t]
odds_pred[prev,state,i,t] <- exp(alpha[prev,state,i] +
beta1[prev,state]*x1[t,i]
+ beta2[prev,state]*x2[t,i]
+ beta3[prev,state]*x3[t,i])
}}
for (t in 1:T) {
totalodds_pred[state,i,t] <- odds_pred[state,1,i,t] + odds_pred[state,2,i,t]
}
}
}

TL;DR: I think you're just missing a likelihood.
Your model is complex, so perhaps I'm missing something, but as far as I can tell there is no likelihood. You are supplying the predictors x1, x2, and x3 as data, but you aren't giving any observed m. So in what sense can JAGS be "fitting" the model?
To answer your questions:
Yes, it appears that m is drawn as random from a categorical distribution conditioned on the rest of the model. Since there are no m supplied as data, none of the parameter distributions have cause for update, so your result for m is no different than you'd get if you just did random draws from all the priors and propagated them through the model in R or whatever.
Though it still wouldn't constitute fitting the model in any sense, you would be free to supply values for beta1 if they weren't already defined completely in the model. JAGS is complaining because currently beta1[i] = rcoeff[i] ~ dt(T.mu, T.tau, T.k), and the parameters to the T distribution are all fixed. If any of (T.mu, T.tau, T.k) were instead given priors (identifying them as random), then beta1 could be supplied as data and JAGS would treat rcoeff[i] ~ dt(T.mu, T.tau, T.k) as a likelihood. But in the model's current form, as far as JAGS is concerned if you supply beta1 as data, that's in conflict with the fixed definition already in the model.
I'm stretching here, but my guess is if you're using JAGS you have (or would like to) fit the model in JAGS too. It's a common pattern to include both an observed response and a desired predicted response in a jags model, e.g. something like this:
model {
b ~ dnorm(0, 1) # prior on b
for(i in 1:N) {
y[i] ~ dnorm(b * x[i], 1) # Likelihood of y | b (and fixed precision = 1 for the example)
}
for(i in 1:N_pred) {
pred_y[i] ~ dnorm(b * pred_x[i], 1) # Prediction
}
}
In this example model, x, y, and pred_x are supplied as data, the unknown parameter b is to be estimated, and we desire the posterior predictions pred_y at each value of pred_x. JAGS knows that the distribution in the first for loop is a likelihood, because y is supplied as data. Posterior samples of b will be constrained by this likelihood. The second for loop looks similar, but since pred_y is not supplied as data, it can do nothing to constrain b. Instead, JAGS knows to simply draw pred_y samples conditioned on b and the supplied pred_x. The values of pred_x are commonly defined to be the same as observed x, giving a predictive interval for each observed data point, or as a regular sequence of values along the x axis to generate a smooth predictive interval.

Related

Predicting new values in jags (mixed model)

I asked a similar question a while ago on how to get model predictions in JAGS for mixed models. Here's my original question.
This time, I'm trying to get predictions for the same model but using new data and not the original that was used to fit the model.
model<-"model {
# Priors
mu_int~dnorm(0, 0.0001)
sigma_int~dunif(0, 100)
tau_int <- 1/(sigma_int*sigma_int)
for (j in 1:(M)){
alpha[j] ~ dnorm(mu_int, tau_int)
}
beta~dnorm(0, 0.01)
sigma_res~dunif(0, 100)
tau_res <- 1/(sigma_res*sigma_res)
# Likelihood
for (i in 1:n) {
mu[i] <- alpha[Mat[i]]+beta*Temp[i] # Expectation
D47[i]~dnorm(mu[i], tau_res) # The actual (random) responses
}
for(i in 1:(n)){
D47_pred[i] <- dnorm(mu[i], tau_res)
}
}"
I know this mcan be done using the posterior distributions of the resulting parameters but I'm wondering if it could also be implemented inside jags.
Thank you!
It absolutely could be done inside JAGS. If you wanted predictions for new values of Temp for some of the same observations in Mat, you would just have to append them to the existing data with a corresponding D47 value of NA.

Exponentiation of vector in JAGS model, Bayesian analysis in R

I have the following JAGS model for use in a Bayesian model in R. I am trying to estimate the posterior distribution for my variable "R". All variables but R are supposed to be deterministic nodes. Each variable, s_A, z_A, z_W, and d are vectors. While tau_s is a data.frame. TTD_aquifer and O2s_all are therefore expected to be a vector for each i.
model {
for (i in 1:N){
y[i] ~ dnorm(mu[i], tau)
mu[i] <- sum(O2s_all)/2
tau_s_bar[i] = (s_A[i]*z_A[i])/R[i]*log(z_A[i]/(z_A[i]-z_W[i]))
TTD_aquifer <- t((d[i]*sqrt(tau_s_bar[i]))/sqrt(4*3.14*d[i]*t(tau_s[,i]^3))*exp(-1*((d[i]*tau_s_bar[i])/(4*t(tau_s[,i])))*
(1-t(tau_s[,i])/tau_s_bar[i])^2))
O2s_all <- t(O2_o[i]-k_o[i]*t(tau_s[,i]))*TTD_aquifer
# prior on R
R[i] ~ dlnorm(-2, 1/(0.6)^2)
}
# prior on tau and sigma
tau <- pow(sigma, -2)
sigma ~ dunif(0, 100)
}
When I run this in jags.model() I get the following error: RUNTIME ERROR:
Invalid vector argument to exp. So it looks like I cannot input a vector into exp() like you can in R. The equations for TTD_aquifer and O2s_all run fine in R for a deterministic example. How should I write my equation for TTD_aquifer in JAGS to avoid the exp issue?
In JAGS, inverse link functions like exp only take scalar arguments. You could change your model to this in order to use exp. Note that you will need to include an object in your data list that denotes how many rows are in the tau_s data frame. Since I do not know what your model is doing I have not checked to determine if your parentheses are in the correct location across all of your divisions and multiplications.
model {
for (i in 1:N){
y[i] ~ dnorm(mu[i], tau)
mu[i] <- sum(O2s_all[,i])/2
tau_s_bar[i] <- (s_A[i]*z_A[i])/R[i]*log(z_A[i]/(z_A[i]-z_W[i]))
for(j in 1:K){ # K = nrow of tau_s
TTD_aquifer[j,i] <- t((d[i]*sqrt(tau_s_bar[i]))/
sqrt(4*3.14*d[i]*t(tau_s[j,i]^3))*
exp(-1*((d[i]*tau_s_bar[i])/(4*t(tau_s[j,i])))*
(1-t(tau_s[j,i])/tau_s_bar[i])^2))
O2s_all[j,i] <- t(O2_o[i]-k_o[i]*t(tau_s[j,i]))*TTD_aquifer[j,i]
} # close K loop
# prior on R
R[i] ~ dlnorm(-2, 1/(0.6)^2)
}
# prior on tau and sigma
tau <- pow(sigma, -2)
sigma ~ dunif(0, 100)
}
As TTD_aquifer and 02s_all should be a vector for each i, they should then be a two dimensional matrix of the same size as tau_s for each step in an MCMC chain. If you have a big dataset (i.e., big N and K) and are running this model for many iterations, tracking those derived parameters will take up considerable memory. Just something to keep in mind if you are running this on a computer without sufficient RAM. Thinning the chain is one way to help deal with the computational intensity of tracking said parameters.

Specify a discrete weibull distribution in JAGS or BUGS for R

I am fitting a weibull model to discrete values using JAGS in R. I have no problem fitting a weibull to continuous data, but I run in to trouble when I switch to discrete values.
Here is some data, and code to fit a weibull model in JAGS:
#draw data from a weibull distribution
y <- rweibull(200, shape = 1, scale = 0.9)
#y <- round(y)
#load jags, specify a jags model.
library(runjags)
j.model ="
model{
for (i in 1:N){
y[i] ~ dweib(shape[i], scale[i])
shape[i] <- b1
scale[i] <- b2
}
#priors
b1 ~ dnorm(0, .0001) I(0, )
b2 ~ dnorm(0, .0001) I(0, )
}
"
#load data as list
data <- list(y=y, N = length(y))
#run jags model.
jags.out <- run.jags(j.model,
data=data,
n.chains=3,
monitor=c('b1','b2')
)
summary(jags.out)
This model fits fine. However, if I transform y values to discrete values using y <- round(y), and run the same model, it fails with the error Error in node y[7], Node inconsistent with parents. The particular number of the node changes every time I try, but its always a low number.
I know I can make this run by adding a very small number to all of my values, however, this does not account for the fact that the data are discrete. I know discrete weibull distributions exists, but how can I implement one in JAGS?
You can use the 'ones trick' to implement a discrete weibull distribution in JAGS. Using the pmf here we can make a function to generate some data:
pmf_weib <- function(x, scale, shape){
exp(-(x/scale)^shape) - exp(-((x+1)/scale)^shape)
}
# probability of getting 0 through 200 with scale = 7 and shape = 4
probs <- pmf_weib(seq(0,200), 7, 4)
y <- sample(0:200, 100, TRUE, probs ) # sample from those probabilities
For the 'ones trick' to work you generally have to divide your new pmf by some large constant to ensure that the probability is between 0 and 1. While it appears that the pmf of the discrete weibull already ensures this, we have still added some large constant in the model anyways. So, here is what the model looks like now:
j.model ="
data{
C <- 10000
for(i in 1:N){
ones[i] <- 1
}
}
model{
for (i in 1:N){
discrete_weib[i] <- exp(-(y[i]/scale)^shape) - exp(-((y[i]+1)/scale)^shape)
ones[i] ~ dbern(discrete_weib[i]/C)
}
#priors
scale ~ dnorm(0, .0001) I(0, )
shape ~ dnorm(0, .0001) I(0, )
}
"
Note that we added 1) a vector of ones and a large constant in the data argument, 2) the pmf of the discrete weibull, and 3) we run that probability through a Bernoulli trial.
You can fit the model with the same code you have above, here is the summary which shows that the model successfully recovered the parameter values (scale = 7 and shape = 4).
Lower95 Median Upper95 Mean SD Mode MCerr MC%ofSD SSeff
scale 6.968277 7.289216 7.629413 7.290810 0.1695400 NA 0.001364831 0.8 15431
shape 3.843055 4.599420 5.357713 4.611583 0.3842862 NA 0.003124576 0.8 15126

How I can simulate response variable from a model already fitted?

I already fitted a regression model with JAGS
model{
for(i in 1:n) {
y[i] ~ dbeta(alpha[i], beta[i])
alpha[i] <- mu[i] * phi[i]
beta[i] <- (1 - mu[i]) * phi[i]
log(phi[i]) <- -inprod(X2[i, ], delta[])
cloglog(mu[i]) <- inprod(X1[i, ], B[])
}
for (j in 1:p){
B[j] ~ dnorm(0, .001)
}
for(k in 1:s){
delta[k] ~ dnorm(0, .001)
}
}
But I need to simulate 50 samples of response variable where each one have size, to do some plots. How can I do it?
I found this thread a litle help Estimating unknown response variable in JAGS - unsupervised learning
Should I run the chain again given the values of posterior estimates that I already have as inits?
I assume that your data are y, X1 and X2.
You can add the 50 lines of data in your X1 and X2 covariates, and add 50 NA values in y. And modify n to include the 50 values.
Your model will then produce predictions for the 50 NA values for y added.
Yes, you can do exactly as you described, as long as you first create a new dataset with 50 observations and the variables Y, X1, and X2 as described by StatnMap (viz., 50 values for both X1 and X2 and 50 NAs for Y), but you will not need to rerun your model, as implied by StatnMap. Just to be clear: you can, but you do not need.

Nonlinear regression with sampling weights (package survey)

I would like to estimate the coefficients of a nonlinear model with a binary dependent variable. The nonlinearity arises because two regressors, A and B, depend on a subset of the dataset and on the two parameters lambda1 and lambda2 respectively:
y = alpha + beta1 * A(lambda1) + beta2 * B(lambda2) + delta * X + epsilon
where for each observation i, we have
Where a and Rs are variables in the data.frame. The regressor B(lambda2) is defined in a similar way.
Moreover, I need to include what in Stata are known as pweights, i.e. survey weights or sampling weights. For this reason, I'm working with the R package survey by Thomas Lumley.
First, I create a function for A (and B), i.e.:
A <- function(l1){
R <- as.matrix(data[,1:(80)])
a <- data[,169]
N = length(a)
var <- numeric(N)
for (i in 1:N) {
ai <- rep(a[i],a[i]-1) # vector of a(i)
k <- 1:(a[i]-1) # numbers from 1 to a(i)-1
num <- (ai-k)^l1
den <- sum((ai-k)^l1)
w <- num/den
w <- c(w,rep(0,dim(R)[2]-length(w)))
var[i] <- R[i,] %*% w
}
return(var)
}
B <- function(l2){
C <- as.matrix(data[,82:(161-1)])
a <- data[,169]
N = length(a)
var <- numeric(N)
for (i in 1:N) {
ai <- rep(a[i],a[i]-1) # vector of a(i)
k <- 1:(a[i]-1) # numbers from 1 to a(i)-1
num <- (ai-k)^l2
den <- sum((ai-k)^l2)
w <- num/den
w <- c(w,rep(0,dim(C)[2]-length(w)))
var[i] <- C[i,] %*% w
}
return(var)
}
But the problem is that I don't know how to include the nonlinear regressors in the model (or in the survey design, using the function svydesign):
d_test <- svydesign(id=~1, data = data, weights = ~data$hw0010)
Because, when I try to estimate the model:
# loglikelihood function:
LLsvy <- function(y, model, lambda1, lambda2){
aux1 <- y * log(pnorm(model))
aux2 <- (1-y) * log(1-pnorm(model))
LL <- (aux1) + (aux2)
return(LL)
}
fit <- svymle(loglike=LLsvy,
formulas=list(~y, model = ~ A(lambda1)+B(lambda2)+X,lambda1=~1,lambda2=~1),
design=d_test,
start=list(c(0,0,0,0),c(lambda1=11),c(lambda2=8)),
na.action="na.exclude")
I get the error message:
Error in eval(expr, envir, enclos) : object 'lambda1' not found
I think that the problem is in including the nonlinear part, because everything works fine if I fix A and B for some lambda1 and lambda2 (so that the model becomes linear):
lambda1=11
lambda2=8
data$A <- A(lambda1)
data$B <- B(lambda2)
d_test <- svydesign(id=~1, data = data, weights = ~data$hw0010)
LLsvylin <- function(y, model){
aux1 <- y * log(pnorm(model))
aux2 <- (1-y) * log(1-pnorm(model))
LL <- (aux1) + (aux2)
return(LL)
}
fitlin <- svymle(loglike=LLsvylin,
formulas=list(~y, model = ~A+B+X),
design=d_test,
start=list(0,0,0,0),
na.action="na.exclude")
On the contrary, if I don't use the sampling weights, I can easily estimate my nonlinear model using the function mle from package stats4 or the function mle2 from package bbmle.
To sum up,
how can I combine sampling weights (svymle) while estimating a nonlinear model (which I can do using mle or mle2)?
=========================================================================
A problem with the nonlinear part of the model arises also when using the function svyglm (with fixed lambda1 and lambda2, in order to get good starting values for svymle):
lambda1=11
lambda2=8
model0 = y ~ A(lambda1) + B(lambda2) + X
probit1 = svyglm(formula = model0,
data = data,
family = binomial(link=probit),
design = d_test)
Because I get the error message:
Error in svyglm.survey.design(formula = model0, data = data, family = binomial(link = probit), :
all variables must be in design= argument
This isn't what svymle does -- it's for generalised linear models, which have linear predictors and a potentially complicated likelihood or loss function. You want non-linear weighted least squares, with a simple loss function but complicated predictors.
There isn't an implementation of design-weighted nonlinear least squares in the survey package, probably because no-one has previously asked for one. You could try emailing the package author.
The upcoming version 4 of the survey package will have a function svynls, so if you know how to fit your model without sampling weights using nls you will be able to fit it with sampling weights.

Resources