// Posterior distribution for "sig_e"
void sig_e_gp(int *n, int *r, int *T, int *rT, int *N, double *shape,
double *prior_b, double *XB, double *o, double *z, double *sig_e,
int *constant, double *sig2e)
{
int i, t, l, n1, r1, T1, col;
n1 =*n;
r1 =*r;
T1 =*T;
col =*constant;
double *z1, *o1, *zo, *zzoo, *XB1, *tmp;
z1 = (double *) malloc((size_t)((n1*col)*sizeof(double)));
o1 = (double *) malloc((size_t)((n1*col)*sizeof(double)));
zo = (double *) malloc((size_t)((n1*col)*sizeof(double)));
zzoo = (double *) malloc((size_t)((col)*sizeof(double)));
XB1 = (double *) malloc((size_t)((n1*col)*sizeof(double)));
tmp = (double *) malloc((size_t)((col)*sizeof(double)));
double u, v, b, sige[1];
u = 0.0;
v = 0.0;
b = 0.0;
for(l=0; l<r1; l++){
for(t=0; t<T1; t++){
extract_alt2(l, t, n, rT, T, o, o1);
extract_alt2(l, t, n, rT, T, z, z1);
extract_alt2(l, t, n, rT, T, XB, XB1);
for(i=0; i<n1; i++){
// zzoo[0] = o1[i]-XB1[i];
zzoo[0] = z1[i]-o1[i];
tmp[0] = 0.005;
mvrnormal(constant, zzoo, tmp, constant, zzoo);
// zo[i] = z1[i]-(o1[i]+zzoo[0]);
zo[i] = zzoo[0];
}
MProd(zo, constant, n, zo, constant, zzoo);
u += zzoo[0];
}
}
b = *prior_b;
u = b + 0.5 * u;
v = *shape;
sige[0] = rigammaa(v, u);
*sig2e = sige[0];
free(z1); free(o1); free(zo); free(zzoo); free(XB1);free(tmp);
return;
}
// Prediction for all sites for all time point "XB"
void z_pr_ar(int *cov, int *nsite, int *n, int *r, int *rT, int *T, int *p,
int *N, double *d, double *d12, double *phip, double *nup,
double *sig_ep, double *sig_etap, double *sig_l0p, double *rhop,
double *betap, double *mu_lp, double *X, double *valX,
double *op, int *constant, double *zpred)
{
int i, j, l, t, r1, col, rT1, n1, nn, ns, p1, N1;
col = *constant;
r1 = *r;
rT1 = *rT;
n1 = *n;
nn = n1*n1;
ns = *nsite;
p1 = *p;
N1 = *N;
int *T1, *T2;
T1 = (int *) malloc((size_t)((r1)*sizeof(int)));
T2 = (int *) malloc((size_t)((r1+1)*sizeof(int)));
for(i=0; i<r1; i++){
T1[i] = T[i];
}
cumsumint(r, T, T2);
double *S_eta, *Si_eta, *S_eta12, *S_eta12c, *det;
S_eta = (double *) malloc((size_t)((n1*n1)*sizeof(double)));
Si_eta = (double *) malloc((size_t)((n1*n1)*sizeof(double)));
S_eta12 = (double *) malloc((size_t)((n1*ns)*sizeof(double)));
S_eta12c = (double *) malloc((size_t)((n1)*sizeof(double)));
det = (double *) malloc((size_t)((col)*sizeof(double)));
covF(cov, n, n, phip, nup, d, S_eta);
MInv(S_eta, Si_eta, n, det);
covF(cov, n, nsite, phip, nup, d12, S_eta12);
double *S, *m1, *O11, *O_l0, *XB;
S = (double *) malloc((size_t)((n1*n1)*sizeof(double)));
m1 = (double *) malloc((size_t)((n1)*sizeof(double)));
O11 = (double *) malloc((size_t)((n1)*sizeof(double)));
O_l0 = (double *) malloc((size_t)((n1*r1*col)*sizeof(double)));
XB = (double *) malloc((size_t)((N1*col)*sizeof(double)));
for(l=0; l<r1; l++){
for(i=0; i<nn; i++){
S[i] = sig_l0p[l]*Si_eta[i];
}
for(i=0; i<n1; i++) {
m1[i] = mu_lp[l];
}
mvrnormal(constant, m1, S, n, O11);
for(i=0; i<n1; i++) {
O_l0[i+l*n1] = O11[i];
}
}
MProd(betap, constant, p, X, N, XB);
double *s21, *sig, *m, *sig_0;
s21 = (double *) malloc((size_t)((col)*sizeof(double)));
sig = (double *) malloc((size_t)((col)*sizeof(double)));
m = (double *) malloc((size_t)((col)*sizeof(double)));
sig_0 = (double *) malloc((size_t)((col)*sizeof(double)));
double *O1, *opp, *XB1, *valX1, *valXB1;
O1 = (double *) malloc((size_t)((col)*sizeof(double)));
opp = (double *) malloc((size_t)((n1)*sizeof(double)));
XB1 = (double *) malloc((size_t)((n1)*sizeof(double)));
valX1 = (double *) malloc((size_t)((p1*ns)*sizeof(double)));
valXB1 = (double *) malloc((size_t)((ns)*sizeof(double)));
double *opp1, *oox, *part2, *out, *out1, *mu, *opre;
opp1 = (double *) malloc((size_t)((n1)*sizeof(double)));
oox = (double *) malloc((size_t)((n1)*sizeof(double)));
part2 = (double *) malloc((size_t)((col)*sizeof(double)));
out = (double *) malloc((size_t)((col)*sizeof(double)));
out1 = (double *) malloc((size_t)((col)*sizeof(double)));
mu = (double *) malloc((size_t)((col)*sizeof(double)));
opre = (double *) malloc((size_t)((rT1*col)*sizeof(double)));
for(j=0; j < ns; j++) {
extn_12(j, n, S_eta12,S_eta12c);
xTay(S_eta12c, Si_eta, S_eta12c, n, s21);
if(s21[0] > 1.0){
s21[0] = 1.0-pow(1,-320);
}
if(s21[0] == 1.0){
s21[0] = 1.0-pow(1,-320);
}
sig[0] = sig_etap[0] * (1.0 - s21[0]);
for(l=0; l < r1; l++) {
t=0;
m[0] = mu_lp[l];
sig_0[0] = sig_l0p[l];
mvrnormal(constant, m, sig_0, constant, O1);
extract_alt_uneqT(l, t, n, r, T, rT, op, opp);
extract_alt_uneqT(l, t, n, r, T, rT, XB, XB1);
extract_X21_uneqT(l, t, nsite, rT, r, T, p, valX, valX1);
// extract_alt2(l, t, n, rT, T, op, opp);
// extract_alt2(l, t, n, rT, T, XB, XB1);
// extract_X21(l, t, nsite, rT, T, p, valX, valX1); // X1 = p x n
MProd(valX1, nsite, p, betap, constant, valXB1);
for(i=0; i < n1; i++){
opp1[i] = O_l0[i+l*n1];
}
for(i=0; i < n1; i++) {
oox[i] = opp[i]-rhop[0]*opp1[i]-XB1[i];
}
xTay(S_eta12c, Si_eta, oox, n, part2);
mu[0] = 0.0;
mvrnormal(constant, mu, sig, constant, out);
mu[0] = 0.0;
mvrnormal(constant, mu, sig_ep, constant, out1);
opre[t+T2[l]]=rhop[0]*O1[0]+valXB1[j]+part2[0];
zpred[t+T2[l]+j*(rT1)]=opre[t+T2[l]]+out[0]+out1[0];
//rhop[0]*O1[0]+valXB1[j]+part2[0]+out[0]+out1[0];
for(t=1; t < T1[l]; t++) {
extract_alt_uneqT(l, t-1, n, r, T, rT, op, opp1);
extract_alt_uneqT(l, t, n, r, T, rT, op, opp);
extract_alt_uneqT(l, t, n, r, T, rT, XB, XB1);
extract_X21_uneqT(l, t, nsite, rT, r, T, p, valX, valX1);
// extract_alt2(l, t-1, n, rT, T, op, opp1);
// extract_alt2(l, t, n, rT, T, op, opp);
// extract_alt2(l, t, n, rT, T, XB, XB1);
// extract_X21(l, t, nsite, rT, T, p, valX, valX1); // X1 = p x n
MProd(valX1, nsite, p, betap, constant, valXB1); // 1 x n
for(i=0; i < n1; i++) {
oox[i] = opp[i]-rhop[0]*opp1[i]-XB1[i];
}
xTay(S_eta12c, Si_eta, oox, n, part2);
mu[0] = 0.0;
mvrnormal(constant, mu, sig, constant, out);
mu[0] = 0.0;
mvrnormal(constant, mu, sig_ep, constant, out1);
opre[t+T2[l]] = rhop[0]*opre[(t-1)+T2[l]]+valXB1[j]+part2[0];
zpred[t+T2[l]+j*(rT1)]=opre[t+T2[l]] + out[0]+ out1[0];
// zpred[t+T2[l]+j*(rT1)]=rhop[0]*zpred[t+T2[l]+j*(rT1)]+valXB1[j]+part2[0] + out[0]+ out1[0];
}
}
}
free(opre);
free(T1); free(T2);
free(mu); free(out1); free(out); free(part2); free(oox); free(opp1);
free(valXB1); free(valX1); free(XB1); free(opp); free(O1); free(sig_0);
free(m); free(sig); free(s21); free(XB); free(O_l0); free(O11); free(m1);
free(S); free(det); free(S_eta12c); free(S_eta12); free(Si_eta); free(S_eta);
return;
}
// K-step Forecasts without its
void zlt_fore_gpp(int *cov, int *K, int *n, int *m, int *r, int *p, int *rT, int *T,
int *rK, int *nrK, double *dnm, double *dm, double *phi, double *nu, double *sig_e,
double *sig_eta, double *beta, double *rho, double *wp, double *foreX,
int *constant, double *foreZ)
{
int l, k, t, i, T1, K1, r1, n1, m1, col;
T1 =*T;
K1 =*K;
r1 =*r;
n1 =*n;
m1 =*m;
col =*constant;
double *C, *det, *I, *A, *mu, *XB, *XB1;
double *wp1, *Aw, *eta, *eps, *zfore;
C = (double *) malloc((size_t)((n1*m1)*sizeof(double)));
// Sigeta = (double *) malloc((size_t)((m1*m1)*sizeof(double)));
// Sinv = (double *) malloc((size_t)((m1*m1)*sizeof(double)));
det = (double *) malloc((size_t)((col)*sizeof(double)));
I = (double *) malloc((size_t)((m1*col)*sizeof(double)));
A = (double *) malloc((size_t)((m1*n1)*sizeof(double)));
mu = (double *) malloc((size_t)((col)*sizeof(double)));
XB = (double *) malloc((size_t)((n1*r1*K1*col)*sizeof(double)));
XB1 = (double *) malloc((size_t)((n1*col)*sizeof(double)));
wp1 = (double *) malloc((size_t)((m1*col)*sizeof(double)));
Aw = (double *) malloc((size_t)((n1*col)*sizeof(double)));
eta = (double *) malloc((size_t)((m1*col)*sizeof(double)));
eps = (double *) malloc((size_t)((col)*sizeof(double)));
zfore = (double *) malloc((size_t)((n1*col)*sizeof(double)));
double *S, *C12c, *s21, *sig;
S = (double *) malloc((size_t)((m1*m1)*sizeof(double)));
C12c = (double *) malloc((size_t)((m1*col)*sizeof(double)));
s21 = (double *) malloc((size_t)((col)*sizeof(double)));
sig = (double *) malloc((size_t)((col)*sizeof(double)));
/*
// exponential covariance
if(cov[0] == 1){
for(i = 0; i < (m1*m1); i++){
S[i] = exp(-1.0*phi[0]*dm[i]);
// Sigeta[i] = sig_eta[0]*S[i];
}
// MInv(Sigeta, Sinv_eta, m, det);
for(i=0; i < m1*n1; i++){
C[i] = exp(-1.0*phi[0]*dnm[i]);
}
}
// gaussian covariance
if(cov[0] == 2){
for(i = 0; i < (m1*m1); i++){
S[i] = exp(-1.0*phi[0]*phi[0]*dm[i]*dm[i]);
// Sigeta[i] = sig_eta[0]*S[i];
}
// MInv(Sigeta, Sinv_eta, m, det);
for(i=0; i < m1*n1; i++){
C[i] = exp(-1.0*phi[0]*phi[0]*dnm[i]*dnm[i]);
}
}
// spherical covariance
if(cov[0] == 3){
for(i = 0; i < (m1*m1); i++){
if(dm[i] > 0 && dm[i] <= 1.0/phi[0]){
S[i] = (1.0-1.5*phi[0]*dm[i]+0.5*(phi[0]*dm[i])*(phi[0]*dm[i])*(phi[0]*dm[i]));
// Sigeta[i] = sig_eta[0]*S[i];
}
else if(dm[i] >= 1.0/phi[0]){
S[i] = 0.0;
// Sigeta[i] = 0.0;
}
else{
S[i] = 1.0;
// Sigeta[i] = 1.0*sig_eta[0];
}
}
// MInv(Sigeta, Sinv_eta, m, det);
for(i=0; i < m1*n1; i++){
if(dnm[i] > 0 && dnm[i] <= 1.0/phi[0]){
C[i] = 1.0-1.5*phi[0]*dnm[i]+0.5*(phi[0]*dnm[i])*(phi[0]*dnm[i])*(phi[0]*dnm[i]);
}
else if(dnm[i] >= 1.0/phi[0]){
C[i] = 0.0;
}
else{
C[i] = 1.0;
}
}
}
// matern covariance, nu = 3/2
if(cov[0] == 4){
for(i = 0; i < (m1*m1); i++){
S[i] = ((1.0+phi[0]*dm[i])*exp(-1.0*phi[0]*dm[i]));
// Sigeta[i] = sig_eta[0]*S[i];
}
// MInv(Sigeta, Sinv_eta, m, det);
for(i=0; i < m1*n1; i++){
C[i] = (1.0+phi[0]*dnm[i])*exp(-1.0*phi[0]*dnm[i]);
}
}
*/
covF(cov, m, m, phi, nu, dm, S);
covF(cov, n, m, phi, nu, dnm, C);
MInv(S, S, m, det); // m x m
MProd(S, m, m, C, n, A); // n x m
for(i=0; i<m1; i++){
I[i] = 0.0;
}
mu[0] = 0.0;
MProd(beta, constant, p, foreX, nrK, XB); // nrK x 1
for(l=0; l<r1; l++){
for(k=0; k<1; k++){
t = (T1-1);
extract_alt2(l, k, n, rK, K, XB, XB1); // n x 1
for(i=0; i<m1; i++){
wp1[i] = wp[i+t*m1+l*m1*T1];
}
MProd(wp1, constant, m, A, n, Aw); // n x 1
for(i=0; i<n1; i++){
extn_12(i, m, C, C12c); // m x 1
xTay(C12c, S, C12c, m, s21); // 1 x 1
if(s21[0] > 1.0){
s21[0] = 1.0-pow(1,-320);
}
if(s21[0] == 1.0){
s21[0] = 1.0-pow(1,-320);
}
sig[0] = sig_eta[0] * (1.0 - s21[0]);
mu[0] = 0.0;
mvrnormal(constant, mu, sig_e, constant, eps);
mu[0] = Aw[i];
mvrnormal(constant, mu, sig, constant, eta);
zfore[i] = XB1[i] + eta[0] + eps[0];
}
put_together1(l, k, n, r, K, foreZ, zfore);
}
for(k=1; k<K1; k++){
for(i=0; i<m1; i++){
wp1[i] = wp1[i]; // m x 1
}
MProd(wp1, constant, m, A, n, Aw); // n x 1
extract_alt2(l, k, n, rK, K, XB, XB1); // n x 1
mvrnormal(constant, mu, sig_e, constant, eps);
for(i=0; i<n1; i++){
extn_12(i, m, C, C12c); // m x 1
xTay(C12c, S, C12c, m, s21); // 1 x 1
if(s21[0] > 1.0){
s21[0] = 1.0-pow(1,-320);
}
if(s21[0] == 1.0){
s21[0] = 1.0-pow(1,-320);
}
sig[0] = sig_eta[0] * (1.0 - s21[0]);
mu[0] = 0.0;
mvrnormal(constant, mu, sig_e, constant, eps);
mu[0] = Aw[i];
mvrnormal(constant, mu, sig, constant, eta);
zfore[i] = XB1[i] + eta[0] + eps[0];
}
put_together1(l, k, n, r, K, foreZ, zfore);
}
}
free(S); free(det);
free(C); free(I);
free(A); free(mu); free(XB); free(XB1); free(wp1); free(Aw);
free(eta); free(eps); free(zfore);
free(C12c); free(s21); free(sig);
return;
}
// The programme for GIBBS SAMPLING with XB and missing values
void GIBBS_gp(double *flag, int *its, int *burnin,
int *n, int *T, int *r, int *rT, int *p, int *N, int *report,
int *cov, int *spdecay, int *ft, double *shape_e, double *shape_eta,
double *phi_a, double *phi_b,
double *prior_a, double *prior_b, double *prior_mubeta,
double *prior_sigbeta, double *prior_omu, double *prior_osig,
double *phi, double *tau, double *phis, int *phik,
double *d, double *sig_e, double *sig_eta,
double *beta, double *X, double *z, double *o, int *constant,
double *phipf, double *accept, double *nupf, double *sig_epf,
double *sig_etapf, double *betapf, double *opf, double *zlt_mean_sd,
double *gof, double *penalty)
{
// unsigned iseed = 44;
// srand(iseed);
int its1, brin, col, i, j, p1, N1, rep1;
double *phip, *sig_ep, *sig_etap, *betap, *op;
double *phi1, *sig_e1, *sig_eta1, *beta1, *o1;
double *z1, *oo, *ot, *acc;
its1 = *its;
brin = *burnin;
col = *constant;
// n1 = *n;
// r1 = *r;
p1 = *p;
N1 = *N;
// nr = n1 * r1;
rep1 = *report;
double accept1, mn_rep[N1], var_rep[N1];
accept1 = 0.0;
for(j=0; j<N1; j++){
mn_rep[j] = 0.0;
var_rep[j] = 0.0;
}
phip = (double *) malloc((size_t)((col)*sizeof(double)));
sig_ep = (double *) malloc((size_t)((col)*sizeof(double)));
sig_etap = (double *) malloc((size_t)((col)*sizeof(double)));
betap = (double *) malloc((size_t)((p1)*sizeof(double)));
op = (double *) malloc((size_t)((N1)*sizeof(double)));
phi1 = (double *) malloc((size_t)((col)*sizeof(double)));
sig_e1 = (double *) malloc((size_t)((col)*sizeof(double)));
sig_eta1 = (double *) malloc((size_t)((col)*sizeof(double)));
beta1 = (double *) malloc((size_t)((p1)*sizeof(double)));
o1 = (double *) malloc((size_t)((N1)*sizeof(double)));
z1 = (double *) malloc((size_t)((N1)*sizeof(double)));
oo = (double *) malloc((size_t)((col)*sizeof(double)));
ot = (double *) malloc((size_t)((col)*sizeof(double)));
acc = (double *) malloc((size_t)((col)*sizeof(double)));
double *nu, *nup;
nu = (double *) malloc((size_t)((col)*sizeof(double)));
nup = (double *) malloc((size_t)((col)*sizeof(double)));
nu[0] = 0.5;
ext_sige(phi, phi1);
ext_sige(sig_e, sig_e1);
ext_sigeta(sig_eta, sig_eta1);
ext_beta(p, beta, beta1);
ext_o(N, o, o1);
ext_o(N, z, z1);
// for missing
for(j=0; j < N1; j++){
if (flag[j] == 1.0){
oo[0]=o1[j];
mvrnormal(constant, oo, sig_e1, constant, ot);
z1[j] = ot[0];
}
else {
z1[j] = z1[j];
}
}
GetRNGstate();
for(i=0; i < its1; i++) {
JOINT_gp(n, T, r, rT, p, N, cov, spdecay, shape_e, shape_eta, phi_a, phi_b,
prior_a, prior_b, prior_mubeta, prior_sigbeta, prior_omu, prior_osig,
phi1, tau, phis, phik, nu, d, sig_e1, sig_eta1, beta1, X, z1, o1, constant,
phip, acc, nup, sig_ep, sig_etap, betap, op);
accept1 += acc[0];
phipf[i] = phip[0];
nupf[i] = nup[0];
sig_epf[i] = sig_ep[0];
sig_etapf[i] = sig_etap[0];
for(j=0; j < p1; j++){
betapf[j+i*p1] = betap[j];
}
for(j=0; j < N1; j++) {
opf[j+i*N1] = op[j];
}
ext_sige(phip, phi1);
ext_sige(nup, nu);
ext_sige(sig_ep, sig_e1);
ext_sige(sig_etap, sig_eta1);
ext_beta(p, betap, beta1);
// ext_o(N, op, o1);
// for pmcc
for(j=0; j < N1; j++){
if(i >= brin){
oo[0] = op[j];
mvrnormal(constant, oo, sig_e1, constant, ot);
// Three options: ft: 0=NONE, 1=SQRT, 2=LOG
if(ft[0]==0){
mn_rep[j] += ot[0];
var_rep[j] += ot[0]*ot[0];
}
else{
if(ft[0]==1){
mn_rep[j] += ot[0]*ot[0];
var_rep[j] += ot[0]*ot[0]*ot[0]*ot[0];
}
else{
mn_rep[j] += exp(ot[0]);
var_rep[j] += exp(ot[0])*exp(ot[0]);
}
}
}
}
// for missing
for(j=0; j < N1; j++){
if (flag[j] == 1.0){
oo[0]=op[j];
mvrnormal(constant, oo, sig_e1, constant, ot);
z1[j] = ot[0];
}
else {
z1[j] = z1[j];
}
}
if(cov[0]==4){
GP_para_printRnu(i, its1, rep1, p1, accept1, phip, nup, sig_ep, sig_etap, betap);
}
else {
GP_para_printR (i, its1, rep1, p1, accept1, phip, sig_ep, sig_etap, betap);
}
} // end of iteration loop
PutRNGstate();
accept[0] = accept1;
double pen, go;
pen = 0;
go =0;
int iit;
iit = 0;
iit = its1-brin;
// fitted zlt, mean and sd
for(j=0; j < N1; j++){
mn_rep[j] = mn_rep[j]/iit;
var_rep[j] = var_rep[j]/iit;
var_rep[j] = var_rep[j] - mn_rep[j]*mn_rep[j];
zlt_mean_sd[j] = mn_rep[j];
zlt_mean_sd[j+N1] = sqrt(var_rep[j]);
}
// pmcc
for(j=0; j < N1; j++){
if (flag[j] == 1.0){
mn_rep[j] = 0.0;
var_rep[j] = 0.0;
}
else{
mn_rep[j] = mn_rep[j];
var_rep[j] = var_rep[j];
mn_rep[j] = (mn_rep[j] - z1[j])*(mn_rep[j] - z1[j]);
}
pen += var_rep[j];
go += mn_rep[j];
}
gof[0] = go;
penalty[0] = pen;
free(phip); free(nu); free(nup); free(sig_ep); free(sig_etap); free(betap);
free(op); free(phi1); free(sig_e1); free(sig_eta1); free(beta1); free(o1);
free(z1); free(oo); free(ot); free(acc);
return;
}
// The programme for GIBBS SAMPLING with XB and missing values
// with all summary values (mean, variance/sd, low2.5, up97.5)
// also the predictions into another sites
// output into the txt files
void GIBBS_sumpred_txt_gp(int *aggtype, double *flag, int *its, int *burnin,
int *n, int *T, int *r, int *rT, int *p, int *N, int *report,
int *cov, int *spdecay, double *shape_e, double *shape_eta,
double *phi_a, double *phi_b,
double *prior_a, double *prior_b, double *prior_mubeta,
double *prior_sigbeta, double *prior_omu, double *prior_osig,
double *phi, double *tau, double *phis, int *phik,
double *d, double *sig_e, double *sig_eta,
double *beta, double *X, double *z, double *o, int *constant,
int *nsite, int *valN, double *d12, double *valX, int *transform,
double *accept_f, double *gof, double *penalty)
{
// unsigned iseed = 44;
// srand(iseed);
int its1, col, i, j, r1, rT1, p1, N1, rep1, nsite1, brin, trans1;
its1 = *its;
col = *constant;
// n1 = *n;
r1 = *r;
rT1 = *rT;
p1 = *p;
N1 = *N;
// nr = n1 * r1;
rep1 = *report;
nsite1 = *nsite;
brin = *burnin;
trans1 = *transform;
double *phip, *sig_ep, *sig_etap, *betap;
double *op;
double *phi1, *sig_e1, *sig_eta1, *beta1;
double *o1;
double *oo, *ot, *acc;
double accept1, *mn_rep, *var_rep;
accept1 = 0.0;
mn_rep = (double *) malloc((size_t)((N1)*sizeof(double)));
var_rep = (double *) malloc((size_t)((N1)*sizeof(double)));
for(j=0; j<N1; j++){
mn_rep[j] = 0.0;
var_rep[j] = 0.0;
}
double *pr_mn, *pr_var;
pr_mn = (double *) malloc((size_t)((nsite1*rT1)*sizeof(double)));
pr_var = (double *) malloc((size_t)((nsite1*rT1)*sizeof(double)));
for(j=0; j<nsite1*rT1; j++){
pr_mn[j] = 0.0;
pr_var[j] = 0.0;
}
phip = (double *) malloc((size_t)((col)*sizeof(double)));
sig_ep = (double *) malloc((size_t)((col)*sizeof(double)));
sig_etap = (double *) malloc((size_t)((col)*sizeof(double)));
betap = (double *) malloc((size_t)((p1)*sizeof(double)));
op = (double *) malloc((size_t)((N1)*sizeof(double)));
phi1 = (double *) malloc((size_t)((col)*sizeof(double)));
sig_e1 = (double *) malloc((size_t)((col)*sizeof(double)));
sig_eta1 = (double *) malloc((size_t)((col)*sizeof(double)));
beta1 = (double *) malloc((size_t)((p1)*sizeof(double)));
o1 = (double *) malloc((size_t)((N1)*sizeof(double)));
oo = (double *) malloc((size_t)((col)*sizeof(double)));
ot = (double *) malloc((size_t)((col)*sizeof(double)));
acc = (double *) malloc((size_t)((col)*sizeof(double)));
double *zp, *anf;
zp = (double *) malloc((size_t)((nsite1*rT1)*sizeof(double)));
anf = (double *) malloc((size_t)((nsite1*r1)*sizeof(double)));
double *nu, *nup;
nu = (double *) malloc((size_t)((col)*sizeof(double)));
nup = (double *) malloc((size_t)((col)*sizeof(double)));
nu[0] = 0.5;
ext_sige(phi, phi1);
ext_sige(sig_e, sig_e1);
ext_sigeta(sig_eta, sig_eta1);
ext_beta(p, beta, beta1);
ext_o(N, o, o1);
// for missing
for(j=0; j < N1; j++){
if (flag[j] == 1.0){
oo[0]=o1[j];
mvrnormal(constant, oo, sig_e1, constant, ot);
z[j] = ot[0];
}
else {
z[j] = z[j];
}
}
FILE *parafile;
parafile = fopen("OutGP_Values_Parameter.txt", "w");
FILE *zpfile;
zpfile = fopen("OutGP_Stats_FittedValue.txt", "w");
FILE *predfile;
predfile = fopen("OutGP_Values_Prediction.txt", "w");
FILE *predfilestat;
predfilestat = fopen("OutGP_Stats_PredValue.txt", "w");
int type1;
type1= *aggtype;
FILE *textan;
// none
if(type1==0){
textan = fopen("OutGP_NONE.txt", "w");
}
// annual average value
if(type1==1){
textan = fopen("OutGP_Annual_Average_Prediction.txt", "w");
}
// annual 4th highest value
if(type1==2){
textan = fopen("OutGP_Annual_4th_Highest_Prediction.txt", "w");
}
// annual w126 option
if(type1==3){
textan = fopen("OutGP_Annual_w126_Prediction.txt", "w");
}
GetRNGstate();
for(i=0; i < its1; i++) {
JOINT_gp(n, T, r, rT, p, N, cov, spdecay, shape_e, shape_eta, phi_a, phi_b,
prior_a, prior_b, prior_mubeta, prior_sigbeta, prior_omu, prior_osig,
phi1, tau, phis, phik, nu, d, sig_e1, sig_eta1, beta1, X, z, o1, constant,
phip, acc, nup, sig_ep, sig_etap, betap, op);
z_pr_gp(cov, nsite, n, r, rT, T, p, N, valN, d, d12, phip, nup,
sig_ep, sig_etap, betap, X, valX, op, constant, zp);
accept1 += acc[0];
for(j=0; j < p1; j++){
fprintf(parafile, "%f ", betap[j]);
}
fprintf(parafile, "%f ", sig_ep[0]);
fprintf(parafile, "%f ", sig_etap[0]);
fprintf(parafile, "%f ", phip[0]);
if(cov[0]==4){
fprintf(parafile, "%f ", nup[0]);
}
fprintf(parafile, "\n");
// for pmcc, fitted
for(j=0; j < N1; j++){
if(i >= brin){
oo[0] = op[j];
mvrnormal(constant, oo, sig_e1, constant, ot);
mn_rep[j] += ot[0];
var_rep[j] += ot[0]*ot[0];
}
}
// prediction samples
for(j=0; j<(nsite1*rT1); j++){
if(trans1 == 0){
if(i >= brin){
zp[j] = zp[j];
fprintf(predfile, "%f ", zp[j]);
pr_mn[j] += zp[j];
pr_var[j] += zp[j]*zp[j];
}
}
if(trans1 == 1){
if(i >= brin){
zp[j] = zp[j]*zp[j];
fprintf(predfile, "%f ", zp[j]);
pr_mn[j] += zp[j];
pr_var[j] += zp[j]*zp[j];
}
}
if(trans1 == 2){
if(i >= brin){
zp[j] = exp(zp[j]);
fprintf(predfile, "%f ", zp[j]);
pr_mn[j] += zp[j];
pr_var[j] += zp[j]*zp[j];
}
}
}
fprintf(predfile, "\n");
if(cov[0]==4){
GP_para_printRnu(i, its1, rep1, p1, accept1, phip, nup, sig_ep, sig_etap, betap);
}
else {
GP_para_printR (i, its1, rep1, p1, accept1, phip, sig_ep, sig_etap, betap);
}
if(i >= brin){
annual_aggregate_uneqT(aggtype, nsite, r, T, rT, zp, anf);
// annual_aggregate(aggtype, nsite, r, T, zp, anf);
for(j=0; j<(nsite1*r1); j++){
fprintf(textan, "%f ", anf[j]);
}
fprintf(textan, "\n");
} // end of loop i >= brin
ext_sige(phip, phi1);
ext_sige(nup, nu);
ext_sige(sig_ep, sig_e1);
ext_sige(sig_etap, sig_eta1);
ext_beta(p, betap, beta1);
// for missing
for(j=0; j < N1; j++){
if (flag[j] == 1.0){
oo[0]=op[j];
mvrnormal(constant, oo, sig_e1, constant, ot);
z[j] = ot[0];
}
else {
z[j] = z[j];
}
}
} // end of iteration loop
PutRNGstate();
fclose(parafile);
fclose(predfile);
fclose(textan);
free(phip); free(nu); free(nup); free(sig_ep); free(sig_etap); free(betap);
free(op); free(phi1); free(sig_e1);
free(sig_eta1); free(beta1);
free(o1); free(oo); free(ot); free(acc);
free(zp); free(anf);
accept_f[0] = accept1;
int iit;
iit = 0;
iit = its1 - brin;
double pen, go;
pen = 0.0;
go =0.0;
// fitted zlt, mean and sd
for(j=0; j < N1; j++){
mn_rep[j] = mn_rep[j]/iit;
var_rep[j] = var_rep[j]/iit;
var_rep[j] = var_rep[j] - mn_rep[j]*mn_rep[j];
fprintf(zpfile, "%f , %f \n", mn_rep[j], sqrt(var_rep[j]));
}
fclose(zpfile);
// pmcc
for(j=0; j < N1; j++){
if (flag[j] == 1.0){
mn_rep[j] = 0.0;
var_rep[j] = 0.0;
}
else{
mn_rep[j] = mn_rep[j];
var_rep[j] = var_rep[j];
mn_rep[j] = (mn_rep[j] - z[j])*(mn_rep[j] - z[j]);
}
pen += var_rep[j];
go += mn_rep[j];
}
free(mn_rep); free(var_rep);
penalty[0] = pen;
gof[0] = go;
// predicted mean and sd
for(j=0; j < nsite1*rT1; j++){
pr_mn[j] = pr_mn[j]/iit;
pr_var[j] = pr_var[j]/iit;
pr_var[j] = pr_var[j] - pr_mn[j]*pr_mn[j];
fprintf(predfilestat, "%f , %f \n", pr_mn[j], sqrt(pr_var[j]));
}
fclose(predfilestat);
free(pr_mn); free(pr_var);
// Rprintf("\n---------------------------------------------------------\n");
return;
}
// conditional posterior for o_lt
void o_gp(int *n, int *r, int *T, int *rT, int *p, double *prior_omu,
double *prior_osig, double *sig_e, double *sig_eta, double *S,
double *Qeta, double *XB, double *z, int *constant, double *opost)
{
int i, l, t, r1, nn, row, T1, col, p1;
r1 = *r; row = *n; T1 = *T; nn = row * row; col = *constant;
p1 = *p;
double *o_1, *de_tT, *det1, *chi_tT, *mean1, *XB1, *QXB1, *zT;
o_1 = (double *) malloc((size_t)((row)*sizeof(double)));
de_tT = (double *) malloc((size_t)((nn)*sizeof(double)));
det1 = (double *) malloc((size_t)((col)*sizeof(double)));
chi_tT = (double *) malloc((size_t)((row)*sizeof(double)));
mean1 = (double *) malloc((size_t)((row)*sizeof(double)));
XB1 = (double *) malloc((size_t)((row)*sizeof(double)));
QXB1 = (double *) malloc((size_t)((row)*sizeof(double)));
zT = (double *) malloc((size_t)((row)*sizeof(double)));
// for 1 <= t <= T, the delta part
for(i=0; i < nn; i++) {
de_tT[i] = (1.0/sig_e[0]) + Qeta[i] + 1.0/prior_osig[0];
}
MInv(de_tT, de_tT, n, det1); // n x n
double *term1, *I, *term2, *zt;
term1 = (double *) malloc((size_t)((nn)*sizeof(double)));
I = (double *) malloc((size_t)((row)*sizeof(double)));
term2 = (double *) malloc((size_t)((row)*sizeof(double)));
zt = (double *) malloc((size_t)((row)*sizeof(double)));
// term1 and term2
for(i=0; i < nn; i++) {
term1[i] = (sig_eta[0]/sig_e[0])* S[i];
}
for(i=0; i < row; i++) {
I[i]= 1.0;
}
MProd(I, constant, n, term1, n, term2);
for(l=0; l < r1; l++) {
for(t=0; t < T1; t++) {
extract_alt2(l, t, n, rT, T, XB, XB1);
extract_alt2(l, t, n, rT, T, z, zT);
MProd(zT, constant, n, term1, n, zt);
for(i=0; i < row; i++) {
mean1[i] = (XB1[i]+zt[i])/(1+term2[i]) + prior_omu[0];
}
mvrnormal(constant, mean1, de_tT, n, o_1); // random generator
put_together1(l, t, n, r, T, opost, o_1);
}
} // End of loop year
free(o_1); free(de_tT); free(det1); free(chi_tT);
free(mean1); free(XB1); free(QXB1); free(zT);
free(term1); free(I); free(term2); free(zt);
return;
}
// Posterior distribution for "theta"
void beta_gp(int *n, int *r, int *T, int *rT, int *p, double *prior_mu,
double *prior_sig, double *Qeta, double *X, double *o, int *constant,
double *betap)
{
int t, l, i, n1, p1, r1, T1, col;
n1 =*n;
p1 =*p;
r1 =*r;
T1 =*T;
col =*constant;
double *del, *chi, *ot1, *X1, *tX1, *out, *tX1QX1, *tX1Qo, *det, *mu, *I;
del = (double *) malloc((size_t)((p1*p1)*sizeof(double)));
chi = (double *) malloc((size_t)((p1*col)*sizeof(double)));
ot1 = (double *) malloc((size_t)((n1*col)*sizeof(double)));
X1 = (double *) malloc((size_t)((n1*p1)*sizeof(double)));
tX1 = (double *) malloc((size_t)((n1*p1)*sizeof(double)));
out = (double *) malloc((size_t)((n1*p1)*sizeof(double)));
tX1QX1 = (double *) malloc((size_t)((p1*p1)*sizeof(double)));
tX1Qo = (double *) malloc((size_t)((p1*col)*sizeof(double)));
det = (double *) malloc((size_t)((col)*sizeof(double)));
mu = (double *) malloc((size_t)((p1*col)*sizeof(double)));
I = (double *) malloc((size_t)((p1*p1)*sizeof(double)));
for(i=0; i<p1*p1; i++){
del[i] = 0.0;
}
for(i=0; i<p1; i++){
chi[i] = 0.0;
}
for(l=0; l<r1; l++){
for(t=0; t<T1; t++){
extract_X(t, l, n, r, T, p, X, X1); // n x p
MTranspose(X1, p, n, tX1); // p x n
MProd(X1, p, n, Qeta, n, out); // n x p
MProd(out, p, n, tX1, p, tX1QX1); // pxp
MAdd(del, p, p, tX1QX1, del); // pxp
extract_alt2(l, t, n, rT, T, o, ot1); // n x 1
MProd(ot1, constant, n, Qeta, n, out); // n x 1
MProd(out, constant, n, tX1, p, tX1Qo); // p x 1
MAdd(chi, p, constant, tX1Qo, chi); // p x 1
}
}
IdentityM(p, I);
for(i=0; i<p1*p1; i++){
del[i] = del[i] + I[i]*(1.0/prior_sig[0]);
}
free(I);
for(i=0; i<p1; i++){
chi[i] = chi[i] + prior_mu[0]/prior_sig[0];
}
MInv(del, del, p, det);
MProd(chi, constant, p, del, p, mu); // p x 1
mvrnormal(constant, mu, del, p, betap);
free(del); free(chi); free(ot1); free(X1); free(tX1);
free(out); free(tX1QX1); free(tX1Qo); free(det); free(mu);
return;
}
// Joint posterior distribution
void JOINT_gp(int *n, int *T, int *r, int *rT, int *p, int *N,
int *cov, int *spdecay, double *shape_e, double *shape_eta,
double *prior_a, double *prior_b, double *prior_mubeta,
double *prior_sigbeta, double *prior_omu, double *prior_osig,
double *phi, double *tau, double *phis, int *phik, double *nu,
double *d, double *sig_e, double *sig_eta,
double *beta, double *X, double *z, double *o, int *constant,
double *phip, double *accept, double *nup, double *sig_ep, double *sig_etap,
double *betap, double *op)
{
int n1, nn, r1, p1, rn, N1, col;
n1 = *n;
nn = n1*n1;
r1 = *r;
p1 = *p;
rn = r1 *n1;
N1 = *N;
col = *constant;
double *Qeta, *XB, *Sinv, *det, *S;
Qeta = (double *) malloc((size_t)((n1*n1)*sizeof(double)));
XB = (double *) malloc((size_t)((N1)*sizeof(double)));
Sinv = (double *) malloc((size_t)((n1*n1)*sizeof(double)));
det = (double *) malloc((size_t)((1)*sizeof(double)));
S = (double *) malloc((size_t)((n1*n1)*sizeof(double)));
// Rprintf(" phi: %4.4f, cov: %i\n", phi[0], cov[0]);
covFormat(cov, n, phi, nu, d, sig_eta, S, det, Sinv, Qeta);
MProd(beta, constant, p, X, N, XB);
// check nu
if(cov[0]==4){
nu_gp_DIS(cov, Qeta, det, phi, nu, n, r, T, rT, N, d, sig_eta, XB, o,
constant, nup);
// Rprintf(" nu: %4.4f, nup: %4.4f \n", nu[0], nup[0]);
// covFormat(cov, n, phi, nup, d, sig_eta, S, det, Sinv, Qeta);
}
else {
nup[0] = nu[0];
}
// fixed values for phi
if(spdecay[0] == 1){
accept[0] =0.0;
phip[0] = phi[0];
covFormat(cov, n, phip, nup, d, sig_eta, S, det, Sinv, Qeta);
}
// discrete sampling for phi
else if(spdecay[0] == 2){
phi_gp_DIS(cov, Qeta, det, phi, phis, phik, nup, n, r, T, rT, N,
prior_a, prior_b, d, sig_eta, XB, o, constant, accept, phip);
covFormat(cov, n, phip, nup, d, sig_eta, S, det, Sinv, Qeta);
// if(accept[0] == 1.0){
// covFormat(cov, n, phip, nu, d, sig_eta, S, det, Sinv, Qeta);
// }
}
// Random-Walk MH-within-Gibbs sampling for phi
else if(spdecay[0] == 3){
double *Qeta2, *det2, *tmp, *phi2;
Qeta2 = (double *) malloc((size_t)((n1*n1)*sizeof(double)));
det2 = (double *) malloc((size_t)((1)*sizeof(double)));
tmp = (double *) malloc((size_t)((1)*sizeof(double)));
phi2 = (double *) malloc((size_t)((1)*sizeof(double)));
if(phi[0] <= 0){
phi[0] = pow(1,-320);
}
tmp[0] = -log(phi[0]);
// Rprintf(" phi: %4.4f, tmp: %4.4f, cov: %i\n", phi[0], tmp[0], cov[0]);
mvrnormal(constant, tmp, tau, constant, phi2);
phi2[0]= exp(-phi2[0]);
// Rprintf(" phi: %4.4f, tmp: %4.4f, cov: %i\n", phi[0], tmp[0], cov[0]);
covFormat(cov, n, phi2, nup, d, sig_eta, S, det2, Sinv, Qeta2);
// Rprintf(" phi: %4.4f, phi2: %4.4f, cov: %i\n", phi[0], phi2[0], cov[0]);
// randow-walk M
phi_gp_MH(Qeta, Qeta2, det, det2, phi, phi2, n, r, T, rT, N,
prior_a, prior_b, XB, o, constant, accept, phip);
// Rprintf(" phi: %4.4f, phi2: %4.4f, cov: %i\n", phi[0], phi2[0], cov[0]);
if(accept[0] == 1.0){
covFormat(cov, n, phip, nup, d, sig_eta, S, det, Sinv, Qeta);
}
free(Qeta2); free(det2); free(tmp); free(phi2);
}
else {
//;
// exit(9);
}
beta_gp(n, r, T, rT, p, prior_mubeta, prior_sigbeta, Qeta, X, o,
constant, betap);
MProd(betap, constant, p, X, N, XB);
sig_e_gp(n, r, T, rT, N, shape_e, prior_b, XB, o, z, sig_e, constant, sig_ep);
sig_eta_gp(n, r, T, rT, shape_eta, prior_b, Sinv, XB, o, constant, sig_etap);
o_gp(n, r, T, rT, p, prior_omu, prior_osig, sig_e, sig_etap, S, Qeta,
XB, z, constant, op);
free(Qeta); free(XB); free(Sinv); free(det); free(S);
return;
}
