@ This Gauss program simulates Monte Carlo analysis based on Hamilton's (2001) program
    as robustness checks for the forward-looking model
    Sample: 1960:I - 2000:IV @


    output file = junk reset;
    library pgraph, optmum;
    graphset; optset;

format 16,8;

/* loading quarterly data */

nt=164;
n=nt;
load gdp[nt,4]= ..\data\nrphgdp.txt;

@
col.1 = nominal GDP
col.2 = real GDP
col.3 = Potential GDP
col.4 = Hodrick-Prescott filtered real GDP series
@

/* loading monthly Federal Funds rate */

ns = 492;
nn = ns;
load mint[ns,1] = ..\data\mffr.txt;


/* generating GDP gap */

gdpgap = ((gdp[.,2] - gdp[.,3])./ gdp[.,3]) * 100;

/* Generating inflation from the GDP deflator */

gdpdf = (gdp[.,1] ./ gdp[.,2]) * 100;
ginf = (ln(gdpdf[2:nt,1]) -ln(gdpdf[1:nt-1,1])) * 400;  
ginf = zeros(1,1)|ginf; 
inf = ginf; @ annualized quarterly inflation @

/* generating quarterly interest rate */

qint = zeros(nt,1);
i = 1;
do until i>164;
qint[i,1] = mint[3*i-2,1]; @ interest at the first month of the quarter @
i = i+1;
endo;

/* 1-year arithmetic average of current and past interest and inflation rates */

intbar = zeros(nt,1); 
infbar = zeros(nt,1); 

i = 1;
do until i>nt-3;
intbar[i+3,1] = sumc(qint[i:i+3,1])/4;
i = i+1;
endo;

 j = 1;
do until j>nt-4;
infbar[j+4,1] = sumc(inf[j+1:j+4,1])/4;
j = j +1;
endo;

rintbar = intbar[.,1] - infbar[.,1]; @ average real interest rate @

ns1 = 78; @ observations in the first sample@
ns2 = 86; @ observations in the second sample @

infts1 = 4.24; @ estimated inflation target in the Pre-Volcker (1960:I - 1979:II) @
infts2 = 3.58; @ estimated inflation target in the Volcker-Greenspan (1979:III - 2000:IV) @


/* Inflation forecasting equation */

linf = inf[5:nt-1,1]~inf[4:nt-2,1]~inf[3:nt-3,1]~inf[2:nt-4,1];
x1 = ones(nt-5,1)~linf~gdpgap[5:nt-1,1];
y1 = inf[6:nt,1];

  b1 = invpd(x1'*x1)*x1'*y1;
  eps1 = y1 - x1*b1;
  infhat = x1*b1;
  sigolsi = sumc(eps1^2)/(rows(x1)-cols(x1));
  sigmle = sumc(eps1^2)/rows(x1);
  rsqure = (b1'*x1'*x1*b1)/(y1'*y1);
  rbarsq = 1 - (((nt-5-1)/(nt-5-6))*(1-rsqure));
  ss = sigolsi*invpd(x1'*x1);

"1. Estimation of inflation process";
      ""; "a. ols coefficients";b1';
     "b. ols see";;sqrt(sigolsi);
    "c. mle see";;sqrt(sigmle);
    "d. standard errors";sqrt(diag(ss))';
    "e. rbarsquare"; rbarsq; "";

/* gdp gap forecasting equation */

lgdpgap = gdpgap[5:nt-1,1]~gdpgap[4:nt-2,1]~gdpgap[3:nt-3,1]; 

  x2 = ones(nt-5,1)~lgdpgap~rintbar[5:nt-1,1]; 
  y2 = gdpgap[6:nt,1];
  b2 = invpd(x2'*x2)*x2'*y2;
  eps2 = y2 - x2*b2;
  gdpghat = x2*b2;
  sigolso = sumc(eps2^2)/(rows(x2)-cols(x2));
  sigmle = sumc(eps2^2)/rows(x2);
  rsqure = (b2'*x2'*x2*b2)/(y2'*y2);
  rbarsq = 1 - (((nt-5-1)/(nt-5-6))*(1-rsqure));
  ss = sigolso*invpd(x2'*x2);

"2. Estimation of GDP gap";
      ""; "a. ols coefficients";b2';
     "b. ols see";;sqrt(sigolso);
    "c. mle see";;sqrt(sigmle);
    "d. standard errors";sqrt(diag(ss))';
    "e. rbarsquare"; rbarsq; "";

/* inflation deviation and expected output gap */
infhat = zeros(5,1)|infhat;
infgap1 = infhat[1:ns1,1] - 4.24; @ pre-Volcker period @ 
infgap2 = infhat[ns1+1:nt,1] - 3.58; @ Volcker-Greenspan period @
infgap = infgap1| infgap2;

/* GDP gap */
gdpghat = zeros(5,1)|gdpghat;


/* Estimation of linear monetary policy rule */

  x33 = infgap[6:ns1,1]~gdpghat[6:ns1,1];
  x3 = ones(ns1-5,1)~x33~qint[5:ns1-1,1]~qint[4:ns1-2,1];
  y3 = qint[6:ns1,1]; 

  b3 = invpd(x3'*x3)*x3'*y3;
  eps3 = y3 - x3*b3;
  infhat = x3*b3;
  sigolsr = sumc(eps3^2)/(rows(x3)-cols(x3));
   sigmle = sumc(eps3^2)/rows(x3);
   rsqure = (b3'*x3'*x3*b3)/(y3'*y3);
   rbarsq = 1 - (((ns1-5-1)/(ns1-5-5))*(1-rsqure));
   ss = sigolsr*invpd(x3'*x3);
"3. Estimation of linear monetary policy rule";"";   
     ""; "ols coefficients";b3';
     "ols see";;sqrt(sigolsr);
    "mle see";;sqrt(sigmle);
    "standard errors";sqrt(diag(ss))';
    "rbarsquare"; rbarsq; "";

/* Monte Carlo Study */

" *** Monte Carlo Analysis in the Appendix ***";


rndseed 9137841;    @ resets random number generator so that identical sample is
                                      used each time @


nmot = 5000; @ number of replication of data generated for this system @
testt = zeros(nmot,4); @ col.1: LM test statistic, col.2: chi-square form of test,
                                        col.3: p-value, col.4: if p-value < 0.05, it is 1 otherwise 0
                                        for true expected values @
testg = zeros(nmot,4); @ col.1: LM test statistic, col.2: chi-square form of test,
                                        col.3: p-value, col.4: if p-value < 0.05, it is 1 otherwise 0
                                        for generated values @

parat = zeros(nmot,9); @ col.1 - col.3 for nonlinear parameters, 
                                         col.4 - col.8 for linear parameters
                                         col.9 for standard deviation for residual
                                          : true expected value case @  

parag = zeros(nmot,9); @ col.1 - col.3 for nonlinear parameters, 
                                         col.4 - col.8 for linear parameters
                                         col.9 for standard deviation for residual
                                          : generated values @  

separat = zeros(nmot,9); @ col.1 - col.3 for standard error of nonlinear parameters, 
                                         col.4 - col.8 for standard error of linear parameters
                                         col.9 for standard error of standard deviation for residual
                                          : true expected value case @  

separag = zeros(nmot,9); @ col.1 - col.3 for standard error of nonlinear parameters, 
                                         col.4 - col.8 for standard error of linear parameters
                                         col.9 for standard error of standard deviation for residual
                                          : generated values @  


nmm = 1;
do until nmm > nmot;
nt = 164;

/* Data Generating Process */

teinf = zeros(ns1,1); @ One-quarter ahead true expected inflation @
tinf = zeros(ns1,1); @ current true inflation @
teoutg = zeros(ns1,1); @ One-quarter ahead true expected output gap @
toutg = zeros(ns1,1); @ current true output gap @
eint = zeros(ns1,1); 
tint = zeros(ns1,1); @ current true interest rate generating from true inflation and output gap @
tarint = zeros(ns1,1); @ true average real interest rate @
tearint = zeros(ns1,1); @ one-quarter ahead true expected average real interest rate @

/* initial value for inflation, output gap, and interest rate */
tinf[2:5,1] = inf[2:5,1];
toutg[2:5,1] = gdpgap[2:5,1];
tint[2:5,1] = qint[2:5,1];

sdinf = sqrt(sigolsi); @ standard deviation of residual for inflation estimation @ 
sdoutg = sqrt(sigolso); @ standard deviation of residual for output gap estimation @
sdint = sqrt(sigolsr); @ standard deviation of residual for linear monetary policy rule estimation @

k = 1;
do until k>ns1-5;
ptinf = 0.551*tinf[k+4,1]+0.059*tinf[k+3,1]+0.166*tinf[k+2,1]+0.197*tinf[k+1,1];
tinf[k+5,1] = 0.148+ptinf+0.145*toutg[k+4,1]+rndn(1,1)*sdinf;
tarint[k+4,1] = meanc(tint[k+1:k+4,1]) - meanc(tinf[k+1:k+4,1]);
ptoutg = 1.121*toutg[k+4,1]-0.054*toutg[k+3,1]-0.168*toutg[k+2,1];
toutg[k+5,1] = 0.204+ptoutg-0.075*tarint[k+4,1]+rndn(1,1)*sdoutg;

pteinf = 0.551*tinf[k+5,1]+0.059*tinf[k+4,1]+0.166*tinf[k+3,1]+0.197*tinf[k+2,1];
teinf[k+5,1] = 0.148+pteinf+0.145*toutg[k+5,1];
tearint[k+5,1] = meanc(tint[k+1:k+4,1]) - meanc(tinf[k+2:k+5,1]);
pteoutg = 1.121*toutg[k+5,1]-0.054*toutg[k+4,1]-0.168*toutg[k+3,1];
teoutg[k+5,1] = 0.204+pteoutg-0.075*tearint[k+5,1];

ptint = 1.015*tint[k+4,1]-0.345*tint[k+3,1];
tint[k+5,1] = 1.668+0.268*teinf[k+5,1]+0.149*teoutg[k+5,1]+ptint+rndn(1,1)*sdint;

k = k+1;
endo;

/* Generating forecasted inflation and output gap */

/* Inflation forecasting */
 
 x44 = tinf[9:ns1-1,1]~tinf[8:ns1-2,1]~tinf[7:ns1-3,1]~tinf[6:ns1-4,1];
 x4 = ones(ns1-9,1)~x44~toutg[9:ns1-1,1];
 y4 = tinf[10:ns1,1];
 b4 = invpd(x4'*x4)*x4'*y4;
  eps4 = y4 - x4*b4;
  ginfh = x4*b4;
  sigolsgi = sumc(eps4^2)/(rows(x4)-cols(x4));
  sigmle = sumc(eps4^2)/rows(x4);
  rsqure = (b4'*x4'*x4*b4)/(y4'*y4);
  rbarsq = 1 - (((ns1-9-1)/(ns1-9-6))*(1-rsqure));
  ss = sigolsgi*invpd(x4'*x4);
  
/* *** This is optional: estimation of linear inflation process ***
  " Estimation for inflation ";    
  ""; "ols coefficients";b4';
  "ols see";;sqrt(sigolsgi);
  "mle see";;sqrt(sigmle);
  "standard errors";sqrt(diag(ss))';
  "rbarsquare"; rbarsq;    */


/* output gap forecasting */

 x55 = toutg[9:ns1-1,1]~toutg[8:ns1-2,1]~toutg[7:ns1-3,1]; 
 x5 = ones(ns1-9,1)~x55~tarint[9:ns1-1,1]; 
 y5 = toutg[10:ns1,1];
 b5 = invpd(x5'*x5)*x5'*y5;
  eps5 = y5 - x5*b5;
  goutgh = x5*b5;
  sigolsgo = sumc(eps5^2)/(rows(x5)-cols(x5));
   sigmle = sumc(eps5^2)/rows(x5);
   rsqure = (b5'*x5'*x5*b5)/(y5'*y5);
   rbarsq = 1 - (((ns1-9-1)/(ns1-9-6))*(1-rsqure));
   ss = sigolsgo*invpd(x5'*x5);
     "";
/*  *** This is optional: estimation of linear output gap process ***
   "ols coefficients";b5';
     "ols see";;sqrt(sigolsgo);
    "mle see";;sqrt(sigmle);
    "standard errors";sqrt(diag(ss))';
    "rbarsquare"; rbarsq;      */


nts = 1; @ use nts = 1 for true expected inflation and output gap
                         nts = 2 for generated expected inflation and output gap @

do until nts > 2;

nt = 164;
if nts ==1; 
  teinfdv = teinf - 4.24;
  y = tint[9:ns1-1,1];
  x = teinfdv[9:ns1-1,1]~teoutg[9:ns1-1,1];
  xlin = x~tint[8:ns1-2,1]~tint[7:ns1-3,1];
  nt = ns1 - 9;
  n = nt;
endif;


jump6:
if nts == 2;
  ginfdv = ginfh - 4.24;
  ginfdv = zeros(9,1)|ginfdv;
  goutg = zeros(9,1)|goutgh;

  y = tint[9:ns1-1,1];
  x = ginfdv[10:ns1,1]~goutg[10:ns1,1];
  xlin = x~tint[8:ns1-2,1]~tint[7:ns1-3,1];
  nt = ns1 - 9;
  n = nt;
endif;


@ set parameters that describe the data  @
    k = cols(x);                @ k is the number of nonlinear variables @
    klin = 1+cols(xlin);         @ klin is the total number of variables, nonlin
ear, linear
                                              and constant term @
    xwhole = ones(n,1)~xlin;   @ xwhole is (n x klin) @




/* ===========================================================
             CALCULATE and REPORT SOME BASIC STATISTICS
=============================================================*/
xbar = meanc(x);
sigx = sqrt(meanc((x - xbar')^2));

xlinbar = meanc(xlin);
siglinx = sqrt(meanc((xlin - xlinbar')^2));
ybar = meanc(y);
sigy = sqrt(meanc((y-ybar)^2));

xx0 = xwhole'*xwhole;
xx0inv = invpd(xx0);


/* ===========================================================
             SET INITIAL VALUES for GLOBAL VARIABLES
==============================================================*/
 kqopt = 2;
          @ kqopt = 1 means evaluate covariance by iterating as in
                      Theorem 2.2
            kqopt = 2 means evaluate covariance directly from Table 1
             option 2 is faster bust only works for k <= 5 @
   kmle = 1;    @ kmle = 1 will call numerical optimization routines to find MLE
                           kmle = 2 will skip this step @
   kc = 2;
          @ kc = 2 echos parameter values when proc is evaluated
            kc =1 produces no echo @
    gamx = ones(k,1);
          @ gamx can be used to restrict some of the weighting coefficients
            to be zero, if desired @

   ks = 0;
          @ ks = # of smoothed inferences desired
               ks = 0 means only evaluate likelihood function @
   xs = 0;
          @ xs will be a (ks x k) matrix of values for the vector x at which
            mean is to be evaluated for smoothed inference @
  xswhole = 0;
          @ xswhole will be a (ks x klin) matrix for all explanatory variables i
ncluding
               constant term at which mean is to be evaluated for smoothed infer
ence @
 _pdate = "";

/* ===========================================================
             INCLUDE NEEDED PROCEDURES
=============================================================*/
ll = 0;
proc(2) = lsq(yq,x1);
   @ This proc performs an OLS regression of yq on x1
        and puts value of log likelihood in the global scalar ll @
local b,eps,sigols,sigmle,ss,nq;
  b = invpd(x1'*x1)*x1'*yq;
   eps = yq - x1*b;
  sigols = sumc(eps^2)/(rows(x1)-cols(x1));
   sigmle = sumc(eps^2)/rows(x1);
   ss = sigols*invpd(x1'*x1);
   ll = -(n/2)*(1 + ln(2*pi)) - (n/2)*ln(sigmle);

retp(b,sigmle^.5);
endp;

 {bhat,sigmle} = lsq(y,xwhole);
ll0 = ll; @ this saves ll0 for use in adjusting f(y,theta) by scale of f(y) @

#include proccov;
#include procs2;
#include fullproc;


proc (0) = graph1dim(nofx,sigmult,xfix);
     @ this proc fills the (ks x nk) matrix xs and the (ks x klin) matrix xswhole
          with values needed to calculate the
          effect of changing variable nofx with all others fixed at xfix.
          The variable nofx is varied from its value in xfix plus or minus
           sigmult times its standard deviation @
      ks = 61;   @ ks is the number of function evaluations to be performed @
      xs = ones(ks, klin - 1) .* xfix';
      xs[.,nofx]=seqa(xfix[nofx,1]-sigmult*sigx[nofx,1],
(2*sigmult*sigx[nofx,1])/(ks-1),ks);
      xswhole = ones(ks,1) ~ xs;
      xs = xs[.,1:k];
endp;



/* ===========================================================
             PERFORM OLS REGRESSION and TEST for NONLINEARITY
=============================================================*/


 {bhat,sigmle} = lsq(y,xwhole);

/* Skip in the Monte Carlo Analysis

"";"Testing the null hypothesis of linearity with respect to x";
    "Note-- it is maintained under both null and alternative that model ";
   "is linear with respect to elements of xlin other than x";
*/

ehat = y - xwhole*bhat;
zeta = lm2(ehat,xlin,x);
chitest = zeta^2;
pvalue = cdfchic(zeta^2,1);
rej = pvalue .< 0.05;

if nts == 1;
  testt[nmm,.] = zeta~chitest~pvalue~rej;
    if rej ==1;
  goto jumpE;
  else;
  goto jumpG;
  endif;
endif;

if nts == 2;
  testg[nmm,.] = zeta~chitest~pvalue~rej;
  if rej ==1;
   goto jumpE;
   else;
   goto jumpM;
   endif;

endif;


jumpE:

thx = ( 1.5 ./(sigx*sqrt(k)) ) | 1.5;   h = eye(k+1); i = 1; psi = zeros(1,k+2);


kc = 1;

/* ============================================================
               PERFORM IMPORTANCE SAMPLING, if DESIRED
=============================================================*/

/* ============================================================
              SET INITIAL VALUES for PARAMETERS 
   ============================================================ */


jump4:

@ ---------------------- parameters of prior for theta ------------------------------------------ @

meta = 0;                         @ meta is mean of log of eta @
seta = 1.0;                       @ seta is std deviation of log of eta @
mg = ln(1./(sigx*sqrt(k)));  @ mg is k x 1 vector of prior means for ln(g) @
taug = 1.0*ones(k,1);          @ taug is prior std. deviation for ln(g) @
mth = mg | meta;
sigth = taug | seta;


@ ---------------------- parameters of prior for psi ------------------------------------------------ @
nsig = 0.25;                         @ prior is (1/sigma^2) ~ gamma(nsig, lamsig) @
lamsig = nsig*0.5*(sigy^2); 
hbet = n;     
mbet = zeros(klin,1); 
mbet[1,1] = meanc(y);

      @ prior is beta ~ N(mbet,hbet*sigma^2*invpd(xwhole'*xwhole))  @


@ ----------parameters that determine importance sampling density -------------- @
montdf = 2;                  @ montdf is degrees of freedom for student t 
                                         generated importance  density @
montfact = sqrt(2);                  @ montfact is factor by which standard deviations are
                                                    increased to obtain std. deviation of importance density @
pprob = 0.5;          @ pprob = probability of drawing from the Student t versus
                                  the spread-out prior  @

/* Skip in the Monte Carlo Analysis
"";"prior distributions:";
"    ln(eta) ~ Normal(";;meta;;",";;seta;"^2)"; */
ii = 1;
do until ii > k;

/* Skip in the Monte Carlo Analysis
"    ln(g(";;ii;;")) ~ Normal(";;mg[ii,1];;",";;taug[ii,1];;"^2)"; */

ii = ii+1;
endo;

/* Skip in the Monte Carlo Analysis
"    (1/sigma^2) | eta ~ Gamma(";;nsig;;",";; lamsig;;")";
"    beta | sigma,theta ~ N(mbet,hbet*sigma*invpd(xwhole'*xwhole)) ";
"    mbet:";;mbet';
"    hbet:";;hbet;
""; 

"Importance density:";
"    degreees of freedom of t distribution";;montdf;
"    fraction of observations from t distribution";;pprob;
"    factor by which std. deviation of importance density exceeds prior";;montfact;
*/

@ ----------------------- parameters to control monte carlo runs -----------------------@

nmonte = 10000;         @ nmonte is number of monte carlo draws generated @


   thmle = abs(thx);
   pmix = h[1:k+1,1:k+1];

kmle = 2;
pmix = pmix*montfact^2;

uxmix = zeros(nmonte,1);    @uxmix can be used to keep track of
                                                 which component of importance density was used @

@ --------  calculation of constant terms for importance density ------------------- @

tprec = invpd(pmix);
tdet = detl;
tc = gamma( (montdf+k+1)/2 )/gamma(montdf/2);
tc = tc / (   sqrt(tdet) * (montdf * 3.14159)^( (k+1) / 2)  );
nc =1./( sqrt(2*3.14159).*sigth);   @ note that nc is (k +1) x 1 vector @
lnnc =ln(nc);


pmix = chol(pmix);



/* =============================================================
             INCLUDE NECESSARY PROCEDURES
   ============================================================= */

psi = 0; i = 0;                        @ needed to avoid tripping GAUSS error compiling code @
#include bayproc2;

proc normgam(sigtry,bettry,ngam,lamgam,betsy,varsy);
    @ this proc evaluates the log of the product of a gamma(ngam,lamgam) density
     for (1/sigtry) and a N(betsy,sigtry*varsy) density for bettry at the
     points sigtry and bettry @
	local f1,f2,m1,m2;
        if ngam > 10;
     	    f1 = ngam*ln(lamgam) - (ngam - 1)*ln(sigtry) - (lamgam/sigtry) - lnfact(ngam-1);
        else;
           f1 = ngam*ln(lamgam) - (ngam - 1)*ln(sigtry) - (lamgam/sigtry) - ln(gamma(ngam));
        endif;
	m1 = invpd(varsy);
	m2 = detl;
	f2 = (-klin/2)*ln(2*3.1415927*sigtry) -(1/2)*ln(m2);
        f2 = f2 - (1/(2*sigtry))*(bettry-betsy)'*m1*(bettry-betsy);
retp(f1 + f2);
endp;

proc priadj(th);
     @ this proc adds log of prior p(theta) to log of f(y|X,theta) to 
          arrive at log of f(y,theta|X) @
local q;
if ndpchk(16);
       "underflow before calling priadj";
endif;
   q = -((ln(th) - mth)^2)./(2*(sigth^2));
   q = q + lnnc - ln(th);
   q = sumc(q);
if kc > 2;
      "log of prior is";;q;
endif;
q = q + baby(th);  
if ndpchk(16);
   "underflow after calling priadj";
endif;
retp(q);
endp;   


proc stut(nstu,ndif);
      @ this proc generates a (1 x nstu) vector student t with ndf degrees of freedom @
       local stuf,stux;
       stuf = rndn(1,nstu);
       stux = rndn(ndif,1);
       stux  = sumc(stux^2)/ndif;
        stux = sqrt(stux);
       stuf = stuf/stux;
retp(stuf);
endp;

proc mix(i);
      @ this proc generates mixture of prior and MLE-weighted student t variable 
    global:
        thmle = (k+1) x 1 vector of ML estimates
	pmix = (k+1) x (k+1) matrix of cholesky decomposition of montfact^2 times
                     asymptotic  variance-covariance matrix 
        pprob = probability of drawing from the Student t versus the spread-out prior 
     output:
         prmix = (k+1) x 1 vector of variables generated from mixture of spread-out
                       Student t and prior @
local prmix,umix;
         
        umix = rndu(1,1);
        
         if umix < pprob;
              uxmix[i,1] = 1;
              prmix = pmix'*stut(k+1,montdf)' + thmle; 
         else;
              uxmix[i,1] = 0;
              prmix = mth + montfact*sigth.*rndn(k+1,1);
              prmix = exp(prmix);
        endif;
retp(prmix);
endp;

proc impor(thx);
      @ this proc calculates the value of the importance sampling density
           at the point thx @
local val1, val2,val;
    if ndpchk(16);
         "underflow before calling impor";
    endif;
    val1 = - ((ln(thx) - mth)^2) ./ (2 * ((montfact*sigth)^2) );
    val1 = val1 - ln(thx) + lnnc - ln(montfact);
    val1 = sumc(val1);
    val1 = exp(val1);
    if ndpchk(16);
          "underflow after calculating val1";
    endif;
    val2 = (thx - thmle)'*tprec*(thx - thmle); 
    val2 = 1 + val2/montdf; 
    val2 = tc*val2^( -(k+1+montdf)/2 );
    if ndpchk(16);
           "underflow after calculating val2";
    endif;
    val = pprob*val2 + (1 - pprob)*val1;  
    if ndpchk(16);
          "underflow after calling impor";
          "theta is";thx';
    endif;
    if kc > 2;
         "contribution of lognormal component to log importance density";;val1;
         "contribution of student t component to log importance density";;val2;
   endif;
retp(val);
endp;

thet = zeros(nmonte,k+1);
psi = zeros(nmonte,klin+1);

wtchk = zeros(nmonte,2);
thwt = ones(nmonte,1);


i = 1;
do until i > nmonte;
    tryagain:
           if ndpchk(16);
                    "underflow occurred prior to calling mix";
                    ndpclex;
              endif;
    thet[i,.] = mix(i)';
    if ndpchk(16);
                    "underflow occurred just after calling mix";
                    ndpclex;
              endif;

    if minc(thet[i,.]') < 0;
          goto tryagain;
    endif;

    beep1 = priadj(thet[i,.]') - ll0;
     if ndpchk(16);
                    "underflow occurred just after calling priadj";
                    "beep1 is";;beep1;
                    ndpclex;
              endif;
      beep2 = impor(thet[i,.]');
       if ndpchk(16);
                    "underflow occurred just after calling impor";
                    "beep2 is";;beep2;
                    ndpclex;
              endif;
     @ control for underflows @
      if beep1 < -500;
              thwt[i,1] = 0;
      else;
             thwt[i,1] = exp(beep1 - ln(beep2)  );
             wtchk[i,1] = exp(beep1);
             wtchk[i,2] = beep2;
 
        endif;
    
       if ndpchk(16);
                    "underflow occurred right after exp and ln";
                    "beep1 is";;beep1;
                    "beep2 is";;beep2;
                    ndpclex;
              endif;
i = i + 1;
endo;

if ndpchk(16);
    "underflow occurred prior to tabulating monte carlo";
    ndpclex;
endif;

nwt = sumc(thwt);

/* Skip
"sum of weights for Monte Carlo Draws is";;nwt;
"If this is small, there may be a numerical problem with the simulation";
*/

/* " estimated mean for theta parameters"; */
thm = sumc (thet .* thwt);
thm = thm/nwt; @ estimated mean for theta parameters @

/* "estimated standard errors"; */
thv = (thet - thm')'*( (thet - thm') .* thwt) ;
thv = diag(thv/nwt); 
sethv = sqrt(thv); @ estimated standard errors @

/* "standard error of estimated mean"; */
thu = ( (thet - thm') .* thwt )'*( (thet - thm') .* thwt );
thu = diag(thu);
thu = thu ./ (  (sumc(thwt))^2 );
srthu = sqrt(thu); @ standard error of estimated mean @

/* "Geweke's measure of relative efficiency"; 
thv'./(nmonte * thu)'; */

/* "";" estimated mean for psi parameters"; */
psim = sumc (psi .* thwt);
psim = psim/nwt; @ estimated mean for psi parameters @

/* "estimated standard errors"; */
psiv = (psi - psim')'*( (psi - psim') .* thwt) ;
psiv = diag(psiv/nwt);
sepsiv = sqrt(psiv); @ estimated standard errors @

/* "standard error of estimated mean"; */
psiu = ( (psi - psim') .* thwt )'*( (psi - psim') .* thwt );
psiu = diag(psiu);
psiu = psiu ./ (  (sumc(thwt))^2 )';
sepsiu = sqrt(psiu); @ standard error of estimated mean @

/* "Geweke's measure of relative efficiency";
psiv'./(nmonte * psiu)'; */


/* Skip in the monte carlo study

hchk = thwt~wtchk~thet~seqa(1,1,nmonte);
hchk = sortc(hchk,1);
hchk[.,1] = hchk[.,1]/nwt;
hchk[.,2] = hchk[.,2]/sumc(hchk[.,2]);
hchk[.,3] = hchk[.,3]/sumc(hchk[.,3]);
"";"Fraction of distribution accounted for by:";
"          Most influential observation";;hchk[nmonte,1];
"          50 most influential observations";;sumc(hchk[nmonte-49:nmonte,1]);
"";"Fifty most influential observations are as follows";
"weight   f(y,thet)   I(thet)   thet  # in simulation";
format 12,4;
hchk[nmonte-49:nmonte,.];
format 16,8;
*/

if ndpchk(16);
    "underflow occurred as a result of tabulating monte carlo";
    ndpclex;
endif;


/* monte carlo study results */
if nts ==1;
parat[nmm,.] = thm'~psim';
separat[nmm,.] = sqrt(thv)'~sqrt(psiv)';
endif;

if nts ==2;
parag[nmm,.] = thm'~psim';
separag[nmm,.] = sqrt(thv)'~sqrt(psiv)';
goto jumpM;
endif;

@ free up some memory space @
clear hchk, qz*,uxmix,wtchk,xham,xlee1,xmork,xzham,xzmork,xzwhole,_op*;

jumpG:
nts = nts + 1;
endo;


jumpM:

nmm = nmm + 1;
endo;


/* Results of Monte Carlo Analysis */

"";" ** Results of Monte Carlo Analysis ** ";"";
"The number of iterations";; nmot;"";
"Number of monte carlo draws in importance sampling";;nmonte;
"";
rratet = sumc(testt[.,4])/nmot;
rrateg = sumc(testg[.,4])/nmot;

"4.a Rejection rate of the null of linearity when the null is true with true forecasts";
rratet;"";

"4.b. Rejection rate of the null of linearity when the null is true with generated forecasts";
rrateg;"";


tszetat = zeros(nmot,1);
tszetag = zeros(nmot,1);

nj = 1;
do until nj > nmot;
  if testt[nj,4] ==1;
    tszetat[nj,1] = parat[nj,3] / separat[nj,3];
  else;
   tszetat[nj,1] = 0;
  endif;

  if testg[nj,4] == 1;
   tszetag[nj,1] = parag[nj,3] / separag[nj,3];
  else;
   tszetag[nj,1] = 0;
  endif;

nj = nj + 1;
endo;


"5a. The mean values of the estimated t-ratios for zeta hat for true forecasts";
mtszetat = sumc(tszetat)/sumc(testt[.,4]);
mtszetat;"";

"5b. The mean values of the estimated t-ratios for zeta hat for generated forecasts";
mtszetag = sumc(tszetag)/sumc(testg[.,4]);
mtszetag;"";

"6a. The proportions of cases of signifcant zeta at the 5% 
to the total iterations in true forecasts";
sigzetat = tszetat .> 1.96;
psigzt = sumc(sigzetat)/nmot;
psigzt;"";

"6b. The proportions of cases of signifcant zeta at the 5% 
to the total iterations in generated forecasts";
sigzetag = tszetag .> 1.96;
psigzg = sumc(sigzetag)/nmot;
psigzg;"";

"7a. The proportions of cases of signifcant zetat at the 5%
to the number of rejections of the null in true forecasts"; 
psignzt = sumc(sigzetat)/sumc(testt[.,4]);
psignzt;"";

"7b. The proportions of cases of signifcant zetat at the 5%
to the number of rejections of the null in generated forecasts"; 
psignzg = sumc(sigzetag)/sumc(testg[.,4]);
psignzg;"";

end;



