/*
    Triangle_iterated.gss, 5/16/2008
    Results for Triangle Model  
    Iterated Estimation
    Choices for X and Z variables
*/
new;
outwidth 256;
library pgraph;
graphset;
fmtdir="c:\\bfed\\ddisk\\gss\\fmt\\";    @ FMT directior @

@ Variables @
pstr = "p_cpi_all";                @ Price measure @
xstr = "unrate";                   @ Activity Variable Forecast @

@ Forecast Horizon @
h=4;                           @ Forecast Horizon @

@ Parameters @
first_obs=(1953|1);      @ First Observation for some calculations (BP filtering and so forth) @
first_est=(1960|1);      @ First Period for estimation in regression -- missing initial data will override this @
first_fcst=(1977|1);     @ First Period that Forecast is constructed @
i_rpfe = 1;              @ 1 to include RPFE, 0 to exclude @
i_rpimp = 1;             @ 1 to include RPIMP, 0 to exclude @
i_nixon = 1;             @ 1 to include Nixon, 0 to exclude @
i_con_pc = 0;            @ 1 to include constant term in PC regression, 0 to exclude @
i_con_x = 0;             @ 1 to include constant term in AR model for X, 0 to exclude @
i_con_rpfe = 0;          @ 1 to include constant term in AR model for rpfe, 0 to exclude @
i_con_rpimp = 0;         @ 1 to include constant term in AR model for rpimp, 0 to exclude @

@ Lags in PC @
nlags_pc_pi = 24;       @ Lags of pi in PC ... multiple of 4 ... this will be constrained as in Gordon and unit root imposed @
firstlag_x = 0;         @ 0 or 1 @
lastlag_x = 4;
firstlag_rpfe = 0;      @ 0 or 1 @
lastlag_rpfe = 4;
firstlag_rpimp = 1;     @ 0 or 1 @
lastlag_rpimp = 4;

@ AR lags @
max_nar_x = 8;              @ Number of lags in AR for X must be >= lastlag_x @
max_nar_rpfe = 8;           @ Number of lags in AR for rpfe must be >= lastlag_rpfe @
max_nar_rpimp = 8;          @ Number of lags in AR for rpimp must be >= lastlag_rpimp @
ic_ar_x = 0;                @ 0 = fixed; 1 = AIC; 2 = BIC @
ic_ar_rpfe = 0;             @ 0 = fixed; 1 = AIC; 2 = BIC @
ic_ar_rpimp = 0;            @ 0 = fixed; 1 = AIC; 2 = BIC @


@ XGap Model @
igap = 4;                   @ 1 = first difference, 2 = 1-sided BP, 3 = Constant NAIRU, 4 = TV-NAIRU (KF) @

@ TVP Scale Factor @
tvp_fac = 20/200;           @ This is (g/T) in SW JASA paper @

@ Model ID String @
modstr="" $+ pstr $+ "_triangleit_" $+ xstr $+ "_";
modstr = modstr $+ ftocv(igap,1,0) $+ "_";
modstr = modstr $+ ftocv(nlags_pc_pi,2,0) $+ "_";
modstr = modstr $+ ftocv(firstlag_x,1,0) $+ ftocv(lastlag_x,1,0) $+ "_";
modstr = modstr $+ ftocv(firstlag_rpfe,1,0) $+ ftocv(lastlag_rpfe,1,0) $+ "_";
modstr = modstr $+ ftocv(firstlag_rpimp,1,0) $+ ftocv(lastlag_rpimp,1,0) $+ "_";
modstr = modstr $+ ftocv(i_nixon,1,0) $+ ftocv(i_rpfe,1,0) $+ ftocv(i_rpimp,1,0) $+ "_";
modstr = modstr $+ ftocv(max_nar_x,1,0) $+ ftocv(ic_ar_x,1,0) $+ "_";
modstr = modstr $+ ftocv(max_nar_rpfe,1,0) $+ ftocv(ic_ar_rpfe,1,0) $+ "_";
modstr = modstr $+ ftocv(i_con_x,1,0) $+ ftocv(i_con_rpfe,1,0) $+ ftocv(i_con_rpimp,1,0) $+ "_";
modstr = modstr $+ ftocv(h,1,0);

@ BP Filter Parameters @
narpad=4;       @ AR order of BP filter forecasts/backcasts @
updc=2 ;         @ Upper Period Cutoff for BP filter @
lpdc=60;         @ Lower Period Cutoff for BP filter @
bpn=80;          /* Number of Terms in BP filter (symmetric
                  total terms = 2*bpn+1) */

small=1.0e-06;
big=1.0e+06;


if max_nar_x .< lastlag_x; stop; endif;
if max_nar_rpfe .< lastlag_rpfe; stop; endif;
if max_nar_rpimp .< lastlag_rpimp; stop; endif;
if firstlag_x .> 1; stop; endif;
if firstlag_rpfe .> 1; stop; endif;
if firstlag_rpimp .> 1; stop; endif;


#include fcst.prc;
#include bpassar.prc;

/*
@ -- Read in Data, set up calendars and so forth -- @
#include bfed_data_calendar.gss;
stop;
*/

@ Load Data @
load dp_rpfe;
load dp_rpimp;
load calvec;
load dnobs;
load p = ^pstr;
load x = ^xstr;
p=ln(p);
dp=miss(zeros(dnobs,1),0);
dp[2:dnobs]=p[2:dnobs]-p[1:dnobs-1];
#include gordn82q_2.prc;
{nix_on,nix_off}=gordn82q_2(calvec);

@ Save Over Relevant Period @
nfirst=first_obs[1]+(first_obs[2]-1)/4;
ismpl = calvec .>= nfirst-small;
calvec=selif(calvec,ismpl);
p=selif(p,ismpl);
dp=selif(dp,ismpl);
x=selif(x,ismpl);
dp_rpfe=selif(dp_rpfe,ismpl);
dp_rpimp=selif(dp_rpimp,ismpl);
nix_on=selif(nix_on,ismpl);
nix_off=selif(nix_off,ismpl);
dnobs=rows(calvec);

@ Form lags of various variables for use in PC equation @
pc_dp_lags=miss(zeros(dnobs,nlags_pc_pi),0);
pc_dp_rpfe_lags=miss(zeros(dnobs,1+lastlag_rpfe-firstlag_rpfe),0);
pc_dp_rpimp_lags=miss(zeros(dnobs,1+lastlag_rpimp-firstlag_rpimp),0);
pc_x_lags=miss(zeros(dnobs,1+lastlag_x-firstlag_x),0);
ilag=1; do while ilag .<= nlags_pc_pi;
	pc_dp_lags[ilag+1:dnobs,ilag]=dp[1:dnobs-ilag];
ilag=ilag+1; endo;
ilag=firstlag_rpfe; do while ilag .<= lastlag_rpfe;
 j=1+ilag-firstlag_rpfe;
 pc_dp_rpfe_lags[ilag+1:dnobs,j]=dp_rpfe[1:dnobs-ilag];
ilag=ilag+1; endo;
ilag=firstlag_rpimp; do while ilag .<= lastlag_rpimp;
 j=1+ilag-firstlag_rpimp;
 pc_dp_rpimp_lags[ilag+1:dnobs,j]=dp_rpimp[1:dnobs-ilag];
ilag=ilag+1; endo;
ilag=firstlag_x; do while ilag .<= lastlag_x;
 j=1+ilag-firstlag_x;
 pc_x_lags[ilag+1:dnobs,j]=x[1:dnobs-ilag];
ilag=ilag+1; endo;

@ z variables in pc @
pc_z=zeros(dnobs,1);
if i_nixon .== 1;
 pc_z=pc_z~nix_on~nix_off;
endif;
if i_rpfe .== 1;
 pc_z=pc_z~pc_dp_rpfe_lags;
endif;
if i_rpimp .== 1;
 pc_z=pc_z~pc_dp_rpimp_lags;
endif;
if cols(pc_z) .== 1;
 pc_z=miss(0,0);
else;
 pc_z=pc_z[.,2:cols(pc_z)];
endif;


@ Form lags of variables for use in AR regressions @
ar_dp_rpfe_lags=miss(zeros(dnobs,max_nar_rpfe),0);
ar_dp_rpimp_lags=miss(zeros(dnobs,max_nar_rpimp),0);
ilag=1; do while ilag .<= max_nar_rpfe;
 ar_dp_rpfe_lags[ilag+1:dnobs,ilag]=dp_rpfe[1:dnobs-ilag];	
ilag=ilag+1; endo;
ilag=1; do while ilag .<= max_nar_rpimp;
 ar_dp_rpimp_lags[ilag+1:dnobs,ilag]=dp_rpimp[1:dnobs-ilag];	
ilag=ilag+1; endo;

/* Matrices for holding forecasts and actuals
   Note ... forecast at "t" is (400/h)*[p(t+h/t) - p(t)]
            actual at "t" is (400/h)*[p(t+h) - p(t)]
            where p(t) is the logarithm of the price index 
*/

yforc=miss(zeros(dnobs,1),0);    @ Forecast Series @
yact=miss(zeros(dnobs,1),0);     @ Actual Series @
yact[1:dnobs-h]=(400/h)*(p[1+h:dnobs]-p[1:dnobs-h]);

@ -- Key Dates -- @
tmp=first_est[1]+(first_est[2]-1)/4;
tfirst_est=minindc(abs(calvec-tmp));
tmp=first_fcst[1]+(first_fcst[2]-1)/4;
tfirst_fcst=minindc(abs(calvec-tmp));

/* -- Restricted Least Square Matices
      Restictions are R*beta_dplags=rb
      
      There are two sets of restrictions on lags of dp:
        (i) Coefficients on lags j*(1 through 4) are equal
        (iii) Sum of coefficients = 1;
*/
itmp = nlags_pc_pi/4;
if (itmp-floor(itmp+small)) .> 2*small;
 "nlags_pc_pi is not divisable by 4, stopping";
 stop;
endif;
itmp=floor(itmp+small);
R=zeros(3*itmp+1,nlags_pc_pi);
rb=zeros(3*itmp+1,1);
i=1; do while i <= itmp;
	j=4*(i-1);
	k=3*(i-1);
	r[k+1,j+1]=1; r[k+1,j+2]=-1;
	r[k+2,j+2]=1; r[k+2,j+3]=-1;	
	r[k+3,j+3]=1; r[k+3,j+4]=-1;
i=i+1; endo;
r[3*itmp+1,1:nlags_pc_pi]=ones(1,nlags_pc_pi);
rb[3*itmp+1]=1;

t=tfirst_fcst; do while t .<= dnobs-1;
 xgap=miss(zeros(dnobs,1),0);
 @ Step 1; Construct Xgap variable @
 if igap .== 1;  @ First Difference @
  xgap[2:dnobs]=x[2:dnobs]-x[1:dnobs-1];
 elseif igap .== 2; @ 1-sided BP @
 	{xgaptmp,tmp}=bpassar(x[1:t],updc,lpdc,bpn,narpad,1,0);  @ 1 Sided BP Gap @
 	xgap[1:t]=xgaptmp;
 endif;
 if igap .> 2;
  @ Compute PC coefficients @
  ztmp=miss(0,0);
  if rows(pc_z) .> 1;
   ztmp=pc_z[tfirst_est:t,.];
  endif;
  {bplags,bx,bz,bconst}=pc(dp[tfirst_est:t],pc_dp_lags[tfirst_est:t,.],pc_x_lags[tfirst_est:t,.],ztmp,1,r,rb);
 endif;
 if igap .== 3;  @ Constant Nairu @
   xnairu=-bconst/sumc(bx);
   xgap=x-xnairu;
 endif;
 if igap .== 4;  @ TV Nairu @
  @ Compute Residuals -- excluding Constant  @
  e=dp[tfirst_est:t]-pc_dp_lags[tfirst_est:t,.]*bplags-pc_x_lags[tfirst_est:t,.]*bx;
  if rows(ztmp) .> 1;
   e=e-ztmp*bz;
  endif;
  tmp=packr(calvec[tfirst_est:t]~e);
  calvec_p=tmp[.,1];
  e_p=tmp[.,2];
  ndf=rows(e_p)-rows(bplags)/4+1-rows(bx)-rows(bz)-1;
  var_e=(e_p'e_p)/ndf;
  se=sqrt(var_e);     @ Standard deviation of error in equation @
  stvp=tvp_fac*se;
  tvp_const=llm(e_p,se,stvp);
  xtmp=-tvp_const/sumc(bx);
  xnairu=miss(zeros(dnobs,1),0);
  tfirst=minindc(abs(calvec-calvec_p[1]));
  tlast=minindc(abs(calvec-calvec_p[rows(calvec_p)]));
  xnairu[tfirst:tlast]=xtmp;
  xgap=x-xnairu;
 endif;
   
 
 @ Compute lags @
 ar_xgap_lags=miss(zeros(dnobs,max_nar_x),0);
 ilag=1; do while ilag .<= max_nar_x;
  ar_xgap_lags[ilag+1:dnobs,ilag]=xgap[1:dnobs-ilag];	
 ilag=ilag+1; endo;
 pc_xgap_lags=miss(zeros(dnobs,1+lastlag_x-firstlag_x),0);
 ilag=firstlag_x; do while ilag .<= lastlag_x;
  j=1+ilag-firstlag_x;
  pc_xgap_lags[ilag+1:dnobs,j]=xgap[1:dnobs-ilag];
 ilag=ilag+1; endo;
 
 
 @ Compute AR models for the various components @
 {bar_xgap_lags, bar_xgap_c}=arest(xgap[tfirst_est:t],ar_xgap_lags[tfirst_est:t,.],i_con_x,ic_ar_x);
 
 if i_rpfe .== 1;
  {bar_rpfe_lags, bar_rpfe_c}=arest(dp_rpfe[tfirst_est:t],ar_dp_rpfe_lags[tfirst_est:t,.],i_con_rpfe,ic_ar_rpfe);
 endif;
 
 if i_rpimp .== 1;
  {bar_rpimp_lags, bar_rpimp_c}=arest(dp_rpimp[tfirst_est:t],ar_dp_rpimp_lags[tfirst_est:t,.],i_con_rpimp,ic_ar_rpimp);
 endif;
 
 @ Compute PC Model @
 ztmp=miss(0,0);
 if rows(pc_z) .> 1;
  ztmp=pc_z[tfirst_est:t,.];
 endif;
 {pc_bplags,pc_bxgap,pc_bz,pc_bconst}=pc(dp[tfirst_est:t],pc_dp_lags[tfirst_est:t,.],pc_xgap_lags[tfirst_est:t,.],ztmp,i_con_pc,r,rb);
 pc_bnixon=miss(0,0);
 pc_brpfe=miss(0,0);
 pc_brpimp=miss(0,0);
 if i_nixon .== 1;
  pc_bnixon = pc_bz[1:2];
 endif;
 if i_rpfe .== 1;
  n1 = 1+i_nixon*2;
  pc_brpfe = pc_bz[n1:n1+lastlag_rpfe-firstlag_rpfe];
 endif;
 if i_rpimp .== 1;
  n1 = 1+i_nixon*2+i_rpfe*(lastlag_rpfe-firstlag_rpfe+1);
  pc_brpimp = pc_bz[n1:n1+lastlag_rpimp-firstlag_rpimp];
 endif; 
 
 @ Set up State Vector For Forecasting -- ingoring nixon, as this is zero during forecast period @
 n_dp_state = nlags_pc_pi;
 n_xgap_state = maxc(lastlag_x|rows(bar_xgap_lags));
 n_rpfe_state=0;
 if i_rpfe .== 1;
  n_rpfe_state = maxc(lastlag_rpfe|rows(bar_rpfe_lags));
 endif;
 n_rpimp_state=0;
 if i_rpimp .== 1;
   n_rpimp_state = maxc(lastlag_rpimp|rows(bar_rpimp_lags));
 endif;
 st=pc_dp_lags[t+1,.]~ar_xgap_lags[t+1,1:n_xgap_state];
 if i_rpfe .== 1;
  st=st~ar_dp_rpfe_lags[t+1,1:n_rpfe_state];
 endif;
 if i_rpimp .== 1;
  st=st~ar_dp_rpimp_lags[t+1,1:n_rpimp_state];
 endif;
 st=st~1;
 st=st';  @ Time t state vector @
 
 /* State Space System 
    Y = dp~xgap~dp_rpfe~dp_rpimp~1
    
    A*Y = B*Y(-1) + error
    or
    Y = C*Y(-1) + error
*/

A = eye(rows(st));
B = zeros(rows(st),rows(st));
@ Contemporaneous Coefficients in PC Equation @
if firstlag_x .== 0;
 a[1,n_dp_state+1]=-pc_bxgap[1];
endif;
if i_rpfe .== 1;
 if firstlag_rpfe .== 0;
  a[1,n_dp_state+n_xgap_state+1]=-pc_brpfe[1];
 endif;
endif;
if i_rpimp .== 1;
 if firstlag_rpimp .== 0;
  a[1,n_dp_state+n_xgap_state+n_rpfe_state+1]=-pc_brpimp[1];
 endif;
endif;

@ PC Row @
b[1,1:n_dp_state]=pc_bplags';
tmp=pc_bxgap;
if firstlag_x .== 0; tmp=tmp[2:rows(tmp)]; endif;
b[1,n_dp_state+1:n_dp_state+lastlag_x]=tmp';
if i_rpfe .== 1;
 tmp=pc_brpfe;
 if firstlag_rpfe .== 0; tmp=tmp[2:rows(tmp)]; endif;
 b[1,n_dp_state+n_xgap_state+1:n_dp_state+n_xgap_state+lastlag_rpfe]=tmp';
endif;
if i_rpimp .== 1;
 tmp=pc_brpimp;
 if firstlag_rpimp .== 0; tmp=tmp[2:rows(tmp)]; endif;
 b[1,n_dp_state+n_xgap_state+n_rpfe_state+1:n_dp_state+n_xgap_state+n_rpfe_state+lastlag_rpimp]=tmp';
endif;
if i_con_pc .== 1;
 b[1,1+n_dp_state+n_xgap_state+n_rpfe_state+n_rpfe_state]=pc_bconst;
endif;
b[2:n_dp_state,1:n_dp_state-1]=eye(n_dp_state-1);

@ Xgap Row @
ix=n_dp_state;
b[ix+1,ix+1:ix+rows(bar_xgap_lags)]=bar_xgap_lags';
if i_con_x .== 1;
 b[ix+1,cols(b)]=bar_xgap_c;
endif;
if n_xgap_state .> 1;
  b[ix+2:ix+n_xgap_state,ix+1:ix+n_xgap_state-1]=eye(n_xgap_state-1);
endif;

@ RPFE Row @
ix=n_dp_state+n_xgap_state;
if i_rpfe .== 1;
 b[ix+1,ix+1:ix+rows(bar_rpfe_lags)]=bar_rpfe_lags';
 if i_con_rpfe .== 1;
  b[ix+1,cols(b)]=bar_rpfe_c;
 endif;
 if n_rpfe_state .> 1;
  b[ix+2:ix+n_rpfe_state,ix+1:ix+n_rpfe_state-1]=eye(n_rpfe_state-1);
 endif;
endif;

@ RPIMP Row @
ix=n_dp_state+n_xgap_state+n_rpfe_state;
if i_rpimp .== 1;
 b[ix+1,ix+1:ix+rows(bar_rpimp_lags)]=bar_rpimp_lags';
 if i_con_rpimp .== 1;
  b[ix+1,cols(b)]=bar_rpimp_c;
 endif;
 if n_rpimp_state .> 1;
  b[ix+2:ix+n_rpimp_state,ix+1:ix+n_rpimp_state-1]=eye(n_rpimp_state-1);
 endif;
endif;

@ CONSTANT @
b[rows(b),cols(b)]=1;

@ Solve for c @
c=inv(a)*b;

@ Construct forecasts of inflation 1, 2, ..., h periods ahead ... keep sum @
fortmp=0;
s=st;
i=1; do while i <= h;
 s=c*s;
 fortmp=fortmp+s[1];
i=i+1; endo;
 yforc[t]=(400/h)*fortmp;
 
t=t+1; endo;

@ Save Results @
tmp=calvec~yact~yforc;       @ Note: Variable being forecast is (400/h)*[ln(p(t+h))-ln(p(t))] @

str=fmtdir $+ modstr;
save ^str=tmp;




@ -------------------------------------------------------------- @
proc(4) = pc(dp,dplags,x,z,icon,r_plags,rb_plags);

/* Compute PC Regression
   dp = b1*dplags + b2*x + b3*z + b4*1(icon==1)
   Where r_plags*b1=rb_plags
*/
@ Estimate Parameters of PC @
local w, tmp, y, wy, wwi, bols, r_rest, brest, bplags, bx, bz, bconst, resid;

 w = dplags~x;
 if rows(z) .> 1;
  w = w~z;
 endif;
 if icon .== 1;
  w=w~ones(rows(w),1);
 endif;
 tmp=packr(dp~w);
 y=tmp[.,1];
 w=tmp[.,2:cols(tmp)];
 wy=w'y;
 wwi=invpd(w'w);
 bols=wwi*wy;
 r_rest=r_plags;
 if cols(w) .> cols(r_plags);
  r_rest=r_rest~zeros(rows(r_rest),cols(w)-cols(r_plags));
 endif;
 brest=bols-wwi*r_rest'(invpd(r_rest*wwi*r_rest'))*(r_rest*bols-rb_plags);
 bplags=brest[1:cols(dplags)];
 tmp=cols(dplags);
 bx=brest[tmp+1:tmp+cols(x)];
 tmp=tmp+cols(x);
 bz=miss(0,0);
 if rows(z) .> 1;
  bz=brest[tmp+1:tmp+cols(z)];
  tmp=tmp+cols(z);
 endif;
 bconst=miss(0,0);
 if icon .== 1;
  bconst=brest[tmp+1];
 endif;
 resid=y-w*brest;

 retp(bplags,bx,bz,bconst);
endp;

@ -------------------------------------------------------------- @
proc(2) = arest(y,ylags,icon,ic);

local tmp, ytmp, xtmp, nar, ctmp, wtmp, bar_lags, bar_c, btmp;
 
 tmp=packr(y~ylags);
 ytmp=tmp[.,1];
 xtmp=tmp[.,2:cols(tmp)];
 @ Determine the number of lags @
 if ic .== 0;
  nar=cols(ylags);
 elseif ic .> 0;
 	if icon .== 0;
  	{nar,tmp}=icmod0(ytmp,xtmp,ic);
  elseif icon .== 1;
  	ctmp=ones(rows(ytmp),1);
   	{nar,tmp}=icmod1(ytmp,ctmp,xtmp,ic); 	
  endif;
 endif;
 if icon .== 0;
  wtmp=xtmp[.,1:nar];
  bar_lags=ytmp/wtmp;
  bar_c=miss(0,0);
 else;
  wtmp=ones(rows(ytmp),1)~xtmp[.,1:nar];
  btmp=ytmp/wtmp;
  bar_c=btmp[1];
  bar_lags=btmp[2:rows(btmp)];
 endif;
 
 retp(bar_lags,bar_c);
endp;


@ ---------------------------------------------- @

proc(1) = llm(y,se_e,se_a);

@ Compute estimate of local mean in the model 
  y(t) = b(t) + e(t)   (Scalar)
  b(t) = b(t-1) + a(t)  (Scalar)
  
  se_e = stdev(e)
  se_a = stdev(a)
  
  input y is Tx1
  
  output bsmooth is Tx1 -- smoothed estimate of b
  
  vague prior is assumed
   
@

local notim, r, q, x1, x2, x3, p1, p2, x1t, x2t, p1t, p2t, t, h, k, p2i, as, vague, bsmooth;

notim=rows(y);
r=se_e*se_e;
q=se_a*se_a;
x1=0;
vague=1.0e+6;
p1=vague;
x1t=zeros(notim+1,1);
p1t=zeros(notim+1,1);
x2t=zeros(notim+1,1);
p2t=zeros(notim+1,1);
bsmooth=miss(zeros(notim,1),1);

x1t[1]=x1; p1t[1]=p1;
for t (1,notim,1);
	x2=x1;
	p2=p1+q;
	h=p2+r;
	k=p2/h;
	x1=x2+k*(y[t]-x2);
	p1=(1-k)*p2;
	x1t[t+1]=x1;
  p1t[t+1]=p1;
  x2t[t+1]=x2;
  p2t[t+1]=p2;
endfor;
bsmooth[notim]=x1;
x3=x1;
for t (notim,2,-1);
 x2=x2t[t+1];
 p2=p2t[t+1];
 x1=x1t[t];
 p1=p1t[t];
 p2i=1/p2;
 as=p1*p2i;
 x3=x1+as*(x3-x2);
 bsmooth[t-1]=x3;
endfor;
retp(bsmooth);
endp;

@ ---------------------------------------------- @