double
gaussian_sample(gsl_rng *rng, double x) {
double y = x + gsl_rng_uniform(rng) - 0.5;
double lgx = log_gaussian(x);
double lgy = log_gaussian(y);
double log_accept = lgy - lgx; /* Jump distribution is symmetric. */
if (log(gsl_rng_uniform(rng)) < log_accept) {
return y;
} else {
return x;
}
}
void DP_eta_theta(PARAM *param, PRIOR *prior, DATA *data, const gsl_rng *r, int pid, int *inuse) {
int i, j, id, accept, pass;
float Delta, mhratio, newval, scale, tmp_lambda, tmp;
scale = prior->gamma_eta[pid] / (1.0 - prior->gamma_eta[pid]);
if(inuse[pid] == 0) {
pass = 0;
while(!pass) {
newval = 1.0 / gsl_ran_gamma(r, 100.0, 1.0);
if(newval < 2.0) pass = 1;
}
Delta = newval - prior->theta_eta[pid];
prior->theta_eta[pid] = newval;
}
else {
/* metropolis-hastings */
mhratio = 0.0;
Delta = gsl_ran_gaussian(r, 0.1);
if(prior->theta_eta[pid] + Delta <= 0.0 || prior->theta_eta[pid] + Delta > 2.0) {
accept = 0;
}
else {
for(i=0;i<data->nprey;i++) {
if(prior->w_eta[i] == pid) {
for(j=0;j<data->preyNinter[i];j++) {
id = data->p2i[i][j];
if(param->Z[data->a2u[id]] && data->miss[id] == 0) {
tmp_lambda = param->lambda_true[id];
tmp = data->d[id];
mhratio += log_gaussian(tmp, (tmp_lambda), prior->theta_eta[pid]+Delta)
- log_gaussian(tmp, (tmp_lambda), prior->theta_eta[pid]);
}
}
}
}
mhratio += log_inv_gamma( (prior->theta_eta[pid]+Delta), prior->shape_eta, prior->scale_eta)
- log_inv_gamma( prior->theta_eta[pid], prior->shape_eta, prior->scale_eta);
accept = gsl_ran_flat(r, 0.0, 1.0) <= GSL_MIN(1.0, exp(mhratio)) ? 1 : 0 ;
}
/* if accepted, update param and lambda */
if(accept) {
prior->theta_eta[pid] += Delta;
for(i=0;i<data->nprey;i++) {
if(prior->w_eta[i] == pid) {
param->eta[i] += Delta;
}
}
}
}
}
void DP_alpha_IP_w(PARAM *param, PRIOR *prior, DATA *data, const gsl_rng *r, int pid) {
int i,j,id;
float cur_alpha_IP, tmp_lambda, maxl;
float prob[_MAX_COMP_];
for(i=0;i<_MAX_COMP_;i++) prob[i] = log(prior->gamma_alpha_IP[i]);
cur_alpha_IP = param->alpha_IP[pid];
for(i=0;i<_MAX_COMP_;i++) {
for(j=0;j<data->IPNinter[pid];j++) {
id = data->IP2i[pid][j];
if(param->Z[data->a2u[id]]) {
tmp_lambda = param->lambda_true[id] + prior->theta_alpha_IP[i] - cur_alpha_IP;
prob[i] += log_gaussian(data->d[id], (tmp_lambda), param->eta[data->i2p[id]]);
}
}
}
maxl = vec_max(prob, _MAX_COMP_);
for(i=0;i<_MAX_COMP_;i++) prob[i] -= maxl;
for(i=0;i<_MAX_COMP_;i++) prob[i] = exp(prob[i]);
prior->w_alpha_IP[pid] = ranMultinom(r, prob, _MAX_COMP_);
param->alpha_IP[pid] = prior->theta_alpha_IP[prior->w_alpha_IP[pid]];
for(j=0;j<data->IPNinter[pid];j++) {
id = data->IP2i[pid][j];
param->lambda_true[id] += param->alpha_IP[pid] - cur_alpha_IP;
}
}
void DP_mu_theta(PARAM *param, PRIOR *prior, DATA *data, const gsl_rng *r, int pid, int *inuse) {
int i, j, id, accept;
float Delta, mhratio, newval, scale, tmp;
scale = prior->gamma_mu[pid] / (1.0 - prior->gamma_mu[pid]);
if(inuse[pid] == 0) {
newval = gsl_ran_gaussian(r, sqrt(prior->v_mu)) + prior->m_mu;
Delta = newval - prior->theta_mu[pid];
prior->theta_mu[pid] = newval;
}
else {
/* metropolis-hastings */
mhratio = 0.0;
Delta = gsl_ran_gaussian(r, 1.0);
for(i=0;i<data->nprey;i++) {
if(prior->w_mu[i] == pid) {
for(j=0;j<data->preyNinter[i];j++) {
id = data->p2i[i][j];
if(data->ctrl[data->i2IP[id]]) {
tmp = data->d[id];
param->lambda_false_tmp[id] = param->lambda_false[id] + Delta;
mhratio += log_poisson_g_prop(tmp, exp(param->lambda_false_tmp[id]), param->eta0[i])
- log_poisson_g_prop(tmp, exp(param->lambda_false[id]), param->eta0[i]);
}
}
}
}
mhratio += log_gaussian(prior->theta_mu[pid] + Delta, prior->m_mu, prior->v_mu)
- log_gaussian(prior->theta_mu[pid], prior->m_mu, prior->v_mu);
accept = gsl_ran_flat(r, 0.0, 1.0) <= GSL_MIN(1.0, exp(mhratio)) ? 1 : 0 ;
/* if accepted, update param and lambda */
if(accept) {
prior->theta_mu[pid] += Delta;
for(i=0;i<data->nprey;i++) {
if(prior->w_mu[i] == pid) {
param->mu[i] += Delta;
for(j=0;j<data->preyNinter[i];j++) {
id = data->p2i[i][j];
param->lambda_false[id] += Delta;
}
}
}
}
}
}
void DP_alpha_IP_theta(PARAM *param, PRIOR *prior, DATA *data, const gsl_rng *r, int pid, int *inuse) {
int i, j, id, accept;
float Delta, mhratio, newval, scale;
scale = prior->gamma_alpha_IP[pid] / (1.0 - prior->gamma_alpha_IP[pid]);
if(inuse[pid] == 0) {
newval = gsl_ran_gaussian(r, sqrt(prior->v_alpha_IP)) + prior->m_alpha_IP;
Delta = newval - prior->theta_alpha_IP[pid];
prior->theta_alpha_IP[pid] = newval;
}
else {
/* metropolis-hastings */
mhratio = 0.0;
Delta = gsl_ran_gaussian(r, 0.25);
for(i=0;i<data->nIP;i++) {
if(prior->w_alpha_IP[i] == pid) {
for(j=0;j<data->IPNinter[i];j++) {
id = data->IP2i[i][j];
if(param->Z[data->a2u[id]] && data->miss[id] == 0) {
param->lambda_true_tmp[id] = param->lambda_true[id] + Delta;
mhratio += log_gaussian(data->d[id], (param->lambda_true_tmp[id]), param->eta[data->i2p[id]])
- log_gaussian(data->d[id], (param->lambda_true[id]), param->eta[data->i2p[id]]);
}
}
}
}
mhratio += log_gaussian(prior->theta_alpha_IP[pid] + Delta, prior->m_alpha_IP, prior->v_alpha_IP)
- log_gaussian(prior->theta_alpha_IP[pid], prior->m_alpha_IP, prior->v_alpha_IP);
accept = gsl_ran_flat(r, 0.0, 1.0) <= GSL_MIN(1.0, exp(mhratio)) ? 1 : 0 ;
/* if accepted, update param and lambda */
if(accept) {
prior->theta_alpha_IP[pid] += Delta;
for(i=0;i<data->nIP;i++) {
if(prior->w_alpha_IP[i] == pid && data->ctrl[i] == 0) {
param->alpha_IP[i] += Delta;
for(j=0;j<data->IPNinter[i];j++) {
id = data->IP2i[i][j];
param->lambda_true[id] += Delta;
}
}
}
}
}
}
void DP_eta_w(PARAM *param, PRIOR *prior, DATA *data, const gsl_rng *r, int pid) {
int i,j,id;
float cur_eta, tmp_lambda, maxl;
float prob[_MAX_COMP_];
for(i=0;i<_MAX_COMP_;i++) prob[i] = log(prior->gamma_eta[i]);
cur_eta = param->eta[pid];
for(i=0;i<_MAX_COMP_;i++) {
for(j=0;j<data->preyNinter[pid];j++) {
id = data->p2i[pid][j];
if(param->Z[data->a2u[id]]) tmp_lambda = param->lambda_true[id];
else tmp_lambda = param->lambda_false[id];
prob[i] += log_gaussian(data->d[id], (tmp_lambda), prior->theta_eta[i]);
}
}
maxl = vec_max(prob, _MAX_COMP_);
for(i=0;i<_MAX_COMP_;i++) prob[i] -= maxl;
for(i=0;i<_MAX_COMP_;i++) prob[i] = exp(prob[i]);
prior->w_eta[pid] = ranMultinom(r, prob, _MAX_COMP_);
param->eta[pid] = prior->theta_eta[prior->w_eta[pid]];
}
void set_Z(PARAM *param, PRIOR *prior, DATA *data, const gsl_rng *r) {
/* Z and iZ */
int i,j,id;
int indiv, total;
int isCtrl, isReverse;
float prob, maxl;
float posi, negi;
float pos, neg, tmp;
for(i=0;i<data->nuinter;i++) {
isCtrl = 0;
for(j=0;j<data->n_u2a[i];j++) {
id = data->u2a[i][j];
if(data->ctrl[data->i2IP[id]] == 1) {
isCtrl = 1;
break;
}
}
isReverse = 0;
for(j=0;j<data->n_u2a[i];j++) {
id = data->u2a[i][j];
if(data->d[id] < param->lambda_false[id]) {
isReverse = 0;
break;
}
}
if(isCtrl || isReverse) {
param->Z[i] = 0;
for(j=0;j<data->n_u2a[i];j++) {
id = data->u2a[i][j];
param->iZ[id] = 0;
}
}
else {
pos = 0.0; neg = 0.0;
for(j=0;j<data->n_u2a[i];j++) {
id = data->u2a[i][j];
tmp = data->d[id];
posi = log_gaussian(tmp, param->lambda_true[id], param->eta[data->i2p[id]]);
negi = log_gaussian(tmp, param->lambda_false[id], param->eta0[data->i2p[id]]);
pos += posi;
neg += negi;
maxl = posi > negi ? posi : negi;
posi -= maxl;
negi -= maxl;
prob = param->ptrue * exp(posi) / (param->ptrue * exp(posi) + (1.0-param->ptrue) * exp(negi));
param->iZ[id] = gsl_ran_flat(r,0.0,1.0) <= prob ? 1 : 0;
}
/* Z */
if(data->n_u2a[i] == 1) {
id = data->u2a[i][0];
param->Z[i] = param->iZ[id];
}
else {
/* maxl = pos > neg ? pos : neg;
pos -= maxl;
neg -= maxl;
prob = param->ptrue * exp(pos) / (param->ptrue * exp(pos) + (1.0-param->ptrue) * exp(neg));
param->Z[i] = gsl_ran_flat(r,0.0,1.0) <= prob ? 1 : 0; */
indiv = 0;
total = data->n_u2a[i];
for(j=0;j<data->n_u2a[i];j++) {
id = data->u2a[i][j];
if(param->iZ[id]) indiv++;
}
pos = ((double) indiv) / ((double) total);
param->Z[i] = gsl_ran_bernoulli(r, pos);
}
}
}
}
