Пример #1
0
// betasp => n x q
// Xsp => N x q
// XB => N x 1
void comb_XB_sp(int *n, int *r, int *T, int *q, double *Xsp, double *betasp, 
     int *constant, double *XB)
{
     int i, j, l, t, n1, r1, T1, q1;
     n1=*n;
     r1=*r;
     T1=*T;
     q1=*q;
     
     double *XB1, *dump, *I;
     XB1 = (double *) malloc((size_t)((n1*n1)*sizeof(double)));
     dump = (double *) malloc((size_t)((n1)*sizeof(double)));
     I = (double *) malloc((size_t)((n1)*sizeof(double)));
               
     for(l=0; l<r1; l++){
        for(t=0; t<T1; t++){
           for(i=0; i<n1; i++){
             I[i] = 0.0;
           }
           for(j=0; j<q1; j++){      
             extract_X_sp2(t, l, j, n, r, T, Xsp, XB1); // n x n
             for(i=0; i<n1; i++){
               dump[i] = betasp[i+j*n1]; // n x 1
             }
             MProd(dump, constant, n, XB1, n, dump); // n x 1 
             MAdd(I, n, constant, dump, I); // n x 1
           }
           put_together1(l, t, n, r, T, XB, I);
        }
     }
     free(XB1); free(dump); free(I);
     return;
}
Пример #2
0
// Posterior distribution for "sig_eta"
void sig_eta_gp(int *n, int *r,  int *T, int *rT, double *shape, 
     double *prior_b, double *Sinv, double *XB, double *o, int *constant, 
     double *sig2eta)     
{
     double *ov, *o1, *out, u, b, sh, sig[1];
     int row, col, l, i, j, r1, T1;
     row = *n;
     col = *constant;
     r1 = *r;
     T1 = *T;
     
     o1 = (double *) malloc((size_t)((row*col)*sizeof(double)));
     ov = (double *) malloc((size_t)((row*col)*sizeof(double)));
     out = (double *) malloc((size_t)((row*col)*sizeof(double)));
          
     double *XB1;
     XB1 = (double *) malloc((size_t)((row*col)*sizeof(double)));
     
     u = 0.0;
     for(l=0; l < r1; l++) {
         for(i=0; i < T1; i++) {                                
             extract_alt2(l, i, n, rT, T, o, o1);
             extract_alt2(l, i, n, rT, T, XB, XB1);
            
             for(j=0; j < row; j++) {
                 ov[j]=o1[j]-XB1[j];
             }
             MProd(ov, constant, n, Sinv, n, out);
             MProd(out, constant, n, ov, constant, out);
             u += out[0];       
//             u += xTay2(ov, Sinv, ov, row);
         }
     }
     b = *prior_b;
     u = b + 0.5 * u;
     sh = *shape;
     sig[0] = rigammaa(sh, u);
     *sig2eta = sig[0]; 
    
     free(ov); free(o1); free(XB1); free(out);
     return;
}
Пример #3
0
// 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;                  
}     
Пример #4
0
// betatp => T x p ??
// Xtp => N x p
// XB => N x 1
void comb_XB_tp(int *n, int *r, int *T, int *p, double *Xtp, double *betatp, 
     int *constant, double *XB)
{
     int t, l, n1, r1, T1, p1;
     n1 =*n;
     r1 =*r;
     T1 =*T;
     p1 =*p;

     double *X1, *beta, *XB1;
     X1 = (double *) malloc((size_t)((n1*p1)*sizeof(double)));
     beta = (double *) malloc((size_t)((p1)*sizeof(double)));
     XB1 = (double *) malloc((size_t)((n1)*sizeof(double)));     
      
     for(l=0; l<r1; l++){
         for(t=0; t<T1; t++){     
             extract_X(t, l, n, r, T, p, Xtp, X1); // nrT x p into n x p
             extract_beta_t(t, T, p, betatp, beta); // p x T into p x 1
             MProd(beta, constant, p, X1, n, XB1); // n x 1
             put_together1(l, t, n, r, T, XB, XB1);
//  int i; 
//  for(i=0; i< n1*p1; i++){
//     Rprintf("  X1: %4.4f, \n", X1[i]);      
//  }
//  for(i=0; i< p1; i++){
//     Rprintf("  beta: %4.4f, \n", beta[i]);      
//  }
//  for(i=0; i< n1; i++){
//     Rprintf("  XB: %4.4f, \n", XB1[i]);      
//  }
         }
     }

     free(X1); free(beta); free(XB1);
     return;
}
Пример #5
0
// 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;
}
Пример #6
0
// 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;
}
Пример #7
0
// 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;
} 
Пример #8
0
// 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;
}     
Пример #9
0
// 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;
}