Article From: Department of Economics
Subject: GMMQ.SET

Posted by: Information Provider
Phone Number: (202) 885-3770
E-Mail Address: econ@american.edu

Post Date: 23 Sep 1994
Expiration Date: 23 Oct 2004


               GMMQ.SET (Hanson, Ogaki, & Heaton)

@ GMMQ.SET @

@------------------------------------------------------------------------------
Prepared by Lars P. Hansen, Masao Ogaki, and John C. Heaton
    Financial support from the National Science Foundation
                 Grant number: SES-8512371

 Last Revision:  03/09/92
------------------------------------------------------------------------------@
/*
This program has been used and seem to be free of errors. However,
we (Lars P. Hansen, John C. Heaton, and Masao Ogaki) do not assume
responsibility for any remaining errors.  In no event shall we be liable to
for any damages whatsoever arising out ot the use of or inability to use
this program.

   @@ This program sets procedure GMMQ.  See GMMQ.EXP for documentation.
      GMMQ.EXP is also an example file.
*/
#include "partinv.prc";
#include "ywp.prc";
@ Globals @
clear bgm,const,const2,W0,gufn,w0flag,calwflag,nv,ordard;
lend=15;
proc hu(b); @ This is a dummy definition, and not used by GMM programs.@
retp(b);
endp;

proc (1)=ufn(b);
retp(const*sumc(hu(b)));
endp;

proc startval;
retp(bgm);
endp;

proc gmmq(&gradq,tend,nzv,rwv,nw,kgm,zero,maxitegm);
local gradq:proc;
local L,nz,maxrw,df,chi,differ,itergm,vbgm,sd,prob,wzp,omega22,tau,ometau,
      snzi,snzi0,igm,w,vp,prob0,differp,
      bmai,i,ib,ie,rzw,rv,rvwz,ep,tma,xpx,ypx,bma,arcoef,omega2;
clear omega22;
L=sumc(nzv);
maxrw=maxc(rwv);
? "Initial values of the coefficients=" bgm';
? "lend=" lend;
? "rwv=" rwv';
format /m1 16,8;
df=L-kgm;
prob0=100;
clear chi;
differ=1e+12;
differp=differ;
if w0flag==1;
 clear w0;
 ? "initial values of parameters are used to caluculate initial W0";
 itergm=0;
 goto lab100;
elseif w0flag==0;
 w0=eye(L);
 ? "Initial W0=I";
 ? "Scaling Constant used for first iteration=" const;
 itergm=1;
 bgm=minquad;
 save bgmi=bgm;
 goto lab100;
endif;
? "W0 in the memory is used as initial W0";
itergm=1;
const=const2;
if w0flag==3;
 vof=ofn(bgm);
? "W0 and bgm in the memory is used for the first GMM result";
 goto lab3200;
endif;
? "W0 in the memory is used for the first GMM result";
do until differ<zero;
     save omega=omega22;
     const=const2;
     bgm=minquad;
     save bgm;
     save w0;
lab3200:
output on;
 gufn=gradq(&ufn,bgm,ufnv,0);
 vbgm=gufn/tend;
 save gammagm=vbgm;   @gamma@
 vbgm=tend*invpd(gufn'w0*gufn./(const^2));  @varb@
 sd=sqrt(diag(vbgm));
 save varb=vbgm;
   @ save variance for bgm [not sqrt(T)*bgm] in VARB.FMT @
? "
================= GMM ITERATION " itergm "====================";
 ? "   b=" bgm';
 ? "   s.e.=" sd';
   if df>0;
     @ S.D. for (1/sqrt(T))*g(b) @
     vbgm=invpd(w0)-(gufn*vbgm*(gufn'))/((const^2)*tend);
     vbgm=sqrt(diag(vbgm));

    chi=(vof)./((const^2).*tend);
    prob=cdfchic(chi,df);
    differp=abs(prob-prob0);
    prob0=prob;
 ? "   chi square=" chi "(" prob ")";
 ? "   d.f.=" df;
 ? "   difference in prob. value from last GMM iteration=" differp;
 ? "(1/sqrt(T))g(b)=" (ufnv')/(const*sqrt(tend));
 ? "           s.e.=" vbgm';
 elseif df==0;? "   Just Identified";
 else;? "   L<kgm; Not Identified";endif;
 ? "   scaling const used is" const;
 if itergm>maxitegm-0.5;  @ or differp<zero;@
  goto labe;
 endif;
 lab100:
 wzp=hu(bgm);
 omega22=wzp'wzp;
 omega2=omega22;  @ Used when omega is not p.d. @
 rzw=(omega22./tend);@ for Durbin's method @
 tau=1;
 do until tau>maxrw-0.5;
  ometau=wzp[(1+tau):tend,.]'wzp[1:(tend-tau),.];
  omega2=omega2+ometau+(ometau');
  clear snzi;
  igm=1;
  do until igm>nw;
   snzi0=snzi+1;
   snzi=snzi+nzv[igm,.];
   if tau>=rwv[igm,.];
    ometau[.,snzi0:snzi]=zeros(sumc(nzv),nzv[igm,.]);
   endif;
   igm=igm+1;
  endo;
  rzw=rzw~(ometau./(tend-tau));
  omega22=omega22+ometau+ometau';
  tau=tau+1;
 endo;
 omega22=omega22./tend;
 if calwflag==3;
  goto ldurb;
 elseif calwflag==4;
  goto lnw;
 elseif calwflag>4;
  goto lnp;
 endif;
 trap 1;
 w=invpd(omega22);
 trap 0;
 if not scalerr(w);
  ? "------- For next GMM iteration
  All the zero restirictions are successfully imposed on W0 -------";
  goto lnexite;
 endif;
 if maxrw==1;
  ? "!!!!! ERROR !!!!! Since max(rwv)=1, OMEGA should be p.s.d.
But OMEGA is not p.d.";
  output off;
  stop;
 endif;
 if minc(rwv) /= maxrw;
  ? "------- OMEGA is not p.d. Now some of the zero restirictions
     on OMEGA are neglected -------";
  omega22=omega2/tend;
  trap 1;
  w=invpd(omega22);
  clear omega2;
  trap 0;
  if not scalerr(w);
   ? "-------- Zero restirictions for t>=maxrw successfully imposed ----";
   goto lnexite;
  endif;
  ? "------- OMEGA is still not p.d. ---------";
 endif;
 ? "OMEGA is not positive definite when
 calculated with zero restrictions.";
 if calwflag==0;
  goto ldurb;
 elseif calwflag==1;
  goto lnw;
 elseif calwflag==2;
  goto lnp;
 endif;

@ Modified Durbin's Method @
   @ 1st Step: Solving Yule-Walker equations to get AR coefficients @
  ldurb:
 ? "------ For next GMM iteration Durbin's Method used for W0 -------";
 ? "Order of AR used=" ordard;
 ? "Order of MA used for zi(t)wi(t) for i=1,...,nw" rwv'-1;
  arcoef=yw(rzw~zeros(L,L*(ordard+1-maxrw)));
  clear rzw;
  @ 2nd Step: OLS to get MA coefficients @
    @ Get e(t)'s in ep@
  ep=wzp[ordard+1:tend,.];
  tau=1;
  do until tau>ordard;
   ep=ep-wzp[ordard+1-tau:tend-tau,.]*(arcoef[.,(tau-1)*L+1:tau*L]');
  tau=tau+1;
  endo;
  wzp=wzp[ordard+1:tend,.];
  tma=tend-ordard;

    @ Regress wi(t)zi(t) on e(t) for i=1,..,nw @
      @ Get X'X in xpx@
  i=1;
  ie=0;
  do until i>nw;
  ib=ie+1;
  ie=ib+nzv[i,1]-1;
  if rwv[i,1]<1.5;
   bmai=zeros(nzv[i,1],(maxrw-1)*L);
   goto linex;
  endif;
  igm=1;
  xpx=zeros((rwv[i,1]-1)*L,(rwv[i,1]-1)*L);
  do until igm>(rwv[i,1]-1);  @row@
   tau=1;
   do until tau>(rwv[i,1]-1); @column@
    xpx[(igm-1)*L+1:igm*L,(tau-1)*L+1:tau*L]=
       ep[rwv[i,1]-igm:tma-igm,.]'ep[rwv[i,1]-tau:tma-tau,.];
    tau=tau+1;
   endo;
   igm=igm+1;
  endo;
      @ Get Y'X in ypx @
  ypx=wzp[rwv[i,1]:tma,ib:ie]'ep[(rwv[i,1]-1):tma-1,.];
  tau=2;
  do until tau>(rwv[i,1]-1);
   ypx=ypx~(wzp[rwv[i,1]:tma,ib:ie]'ep[rwv[i,1]-tau:tma-tau,.]);
   tau=tau+1;
  endo;
      @ Get MA coefficients @
  bmai=ypx*invpd(xpx);
  if maxrw>rwv[i,1];
   bmai=bmai~zeros(nzv[i,1],(maxrw-rwv[i,1])*L);
  endif;
  linex:
  if i==1;
   bma=bmai;
  else;
   bma=bma|bmai;
  endif;
  i=i+1;
  endo;
      @ Get residual for MA in vp @
  vp=wzp[maxrw:tma,.]-ep[maxrw-1:tma-1,.]*(bma[.,1:L]');
  tau=2;
  do until tau>(maxrw-1);
    vp=vp-ep[maxrw-tau:tma-tau,.]*(bma[.,(tau-1)*L+1:tau*L]');
   tau=tau+1;
  endo;
  lomec:
  omega22=eye(L);
  tau=1;
  do until tau>(maxrw-1);
   omega22=omega22+bma[.,(tau-1)*L+1:tau*L];
   tau=tau+1;
  endo;
  omega22=(omega22*vp'vp*(omega22'))/(tma-maxrw+1);
  w=invpd(omega22);
 goto lnexite;

@ NEWEY and WEST Method @
 lnw:
 ? "-----For next GMM iteration Newey and West Method used for W0 ----";
  omega22=wzp'wzp;
  tau=1;
  do until tau>lend;
   ometau=wzp[(tau+1):tend,.]'wzp[1:(tend-tau),.];
   omega22=omega22+(1.0-tau./lend).*(ometau+(ometau'));
   tau=tau+1;
  endo;
  omega22=omega22./tend;
  w=invpd(omega22);
goto lnexite;

@ Parzen's lag window @
 lnp:
 ? "----For next GMM iteration Parzen's lag window used for W0----";
 omega22=wzp'wzp/tend;
 tau=1;
 do until tau>=(lend/2);
  ometau=(wzp[1:tend-tau,.]'wzp[1+tau:tend,.])/tend;
  omega22=omega22+(1-6*((tau/lend)^2)+6*((tau/lend)^3))*(ometau+ometau');
  tau=tau+1;
 endo;
 do until tau>=lend;
  ometau=(wzp[1:tend-tau,.]'wzp[1+tau:tend,.])/tend;
  omega22=omega22+2*((1-tau/lend)^3)*(ometau+ometau');
  tau=tau+1;
 endo;
 w=invpd(omega22);
@ Next Iteration over W0 @
lnexite:
 differ=w-w0;differ=maxc(maxc(abs(differ)));
 ? "   max(|difference|)=" differ;
 w0=w;
 itergm=itergm+1;
endo;
labe:
retp(chi);
endp;
@ ------------------------ End of Program ------------------------------ @

************************************************************************
Department of Economics is entirely responsible for the information
provided above. Please direct any comments to Information Provider at:
          E-Mail Address: econ@american.edu
          Phone Number:   (202) 885-3770