
@ =========================================================== @

proc baby(th);
  /*  This proc calculates the log of the posterior density of y given X and theta 
       and updates a draw for row i of the psi matrix

 Input:
     th = (k+1 x 1) vector of population parameters (g and eta)
 Global variables:
    i = row of psi matrix ready to be generated
    psi = (nmonte x k+2) matrix whose row i is generated vector for psi
    n = number of observations
    k = number of nonlinear explanatory variables (excluding constant term)
    klin = total number of explanatory variables (including constant term)
    nsig = scalar representing strength of prior for (1/sigma)
    lamsig = scalar representing prior value for (1/sigma)
            prior is (1/sigma) ~ gamma(nsig, lamsig) 
    mbet = (klin x 1) vector representing prior mean for beta
    hbet = scalar summarizing prior variance for beta
            prior is beta ~ N(mbet,hbet*sigma*invpd(xwhole'*xwhole))
    y = (n x 1) vector of dependent variables
    x = (n x k) matrix of nonlinear explanatory variables
    xwhole = (n x klin) matrix of all explanatory variables including constant
    xx0 = xwhole'*xwhole
    xx0inv = inv(xx0)
     */
local gam,eta,w0,w0inv,var0inv,betpost,varpost,npost,lampost,wuse,wusedet,
xq,f0,signew,xx,bnew,ck1,ck2,ck3,ck4,ck5,ck6,xxgls,betgls,vargls,xxglsinv,
varbet,varbetinv,lamsig0;

@ ======================================================@
@ read in parameters @

gam = th[1:k,1];
gam = gam .* gamx;
eta =  th[k+1,1]^2;
lamsig0 = lamsig;

@ =====================================================@
@ set initial values @

xq = dist2(x,gam);

@ alternative numerical algorithms for the cases eta > 1 and < 1 are employed
       for numerical stability @
if eta < 1;
     w0 = eta*covary(k,xq) + eye(n);
     w0inv = invpd(w0);
else;
     w0 = covary(k,xq) + eye(n)/eta; 
     w0inv = invpd(w0)/eta;
     w0 = eta*w0;
endif;

xxgls = xwhole'*w0inv*xwhole;
xxglsinv = invpd(xxgls);
varbetinv = xx0/hbet;
varbet = hbet*xx0inv;

betgls = xxglsinv*xwhole'*w0inv*y;

varpost = invpd(  varbetinv + xxgls  );
betpost = varpost*( (varbetinv*mbet) + (xwhole'*w0inv*y)  );

wuse = invpd( w0 + (xwhole*varbet*xwhole') );
wusedet = ln(detl);

npost = nsig + (n/2);
lampost = y - xwhole*mbet;
lampost = lampost'*wuse*lampost/2;
lampost = lamsig0 + lampost;

f0 = lnfact(npost-1) + nsig*ln(lamsig0) - (n/2)*ln(2*3.1415927) - ln(gamma(nsig)) 
       - npost*ln(lampost) - (1/2)*wusedet;
if kc > 2;
     "lampost from first calculation is";;lampost;
     lampost = (y - xwhole*betgls)'*w0inv*(y - xwhole*betgls);
     lampost = lampost + ( (betgls - mbet)'*varbetinv*invpd(xxgls+varbetinv)*xxgls*
                   (betgls - mbet) );
     lampost = lamsig0 + lampost/2;
     "lampost from second calculation is";;lampost;
     "log of determinant is";;wusedet;
     "sum of squared residuals is";;lampost;
     "f0 is";;f0;
endif;

signew = (1/lampost)* rndgam(1,1,npost);
signew = 1/sqrt(signew);
xx = chol(varpost);
bnew = betpost + signew*xx'*rndn(klin,1);
psi[i,.] = bnew' ~ signew;

if kc > 2;
  @ check that equation [12.A.13] holds numerically  @
	ck1 = normgam(signew^2,bnew,nsig,lamsig0,mbet,varbet);
        ck2 = y - xwhole*bnew;
        ck2 = ck2'*w0inv*ck2;
        ck2 = -(n/2)*ln(2*3.1415927*(signew^2)) - (1/2)*ln(det(w0)) - (1/(2*(signew^2)))*ck2;
        ck2 = ck1+ck2;
        "log of posterior density evaluated at bnew and signew: calculation 1";;ck2;
        ck3 = normgam(signew^2,bnew,npost,lampost,betpost,varpost);
        ck4 = f0;
        ck4 = ck3 + ck4;
        "log of posterior density: calculation 2";;ck4;
         ck5 = y - xwhole*mbet;
         ck5 = ck5'*wuse*ck5/(2*(signew^2));
 	ck5 = -ck5 - (n/2)*ln(2*3.1415927*(signew^2)) - (1/2)*wusedet;
         ck6 = normgam(signew^2,bnew,nsig,lamsig0,betpost,varpost);
         "calculation 3";;ck6 = ck5 + ck6; ck6; 
endif;

retp(f0);
endp;

