@>>>>>> Measures of cyclical fluctuations in productivity and hours >>>>>>@

/*** This program calculates the cyclical fluctuations in hours
and productivity using a Kalman filter in a 3 variable UC model. An inflation 
equation of Phillips curve type is introduced in this program. Cyclical productivity 
depends on its own lag (one lag). So does hours cycle (two lags).

All the shocks are correlated. The drift in productivity is with breaks.
We also allow for four breaks in inflation mean as per Bai-Perron tests. 
The non-gap inflation process also includes its own lags. 
The lag of the inflation was chosen on the basis of significance in earlier 
programs.

We have 3 measurement equations, 6 transitory equations and 30 parameters. 
15 parameters are in the var-cov matrix of the shocks.

We have 9 series in the data set, from 1953:2 to 2006:1. The effective data set used
is from 1955:1 - 2006:1.
The series are, sequentially, log output per hour, log hours per capita,
annualized inflation (from non-farm business output deflator), 
4 inflation dummies, nixon dummy and demeaned supply shocks.
This is datafinal.txt in the files.

****/

New;
library optmum,pgraph;
#include optmum.ext;
#include gradient.ext;
optset;

load data[212,9]=c:\arabinda\research\prod\datafinal.txt;

yy1 = data[8:212,1];     @ log Real Output per hour @
yy2 = data[8:212,2];     @ log hour per capita @
yy3 = data[8:212,3];	 @ Inflation rate, non-farm business @
yy = yy1~yy2~yy3;

z0=ones(205,1);

z1=data[8:212,4];     @ 1965:4 inflation mean break dummy @
z2=data[8:212,5];     @ 1973:2 inflation mean break dummy @
z3=data[8:212,6];     @ 1982:4 inflation mean break dummy @
z4=data[8:212,7];     @ 1991:3 inflation mean break dummy @
z5=data[7:211,3];     @ 1 lag inflation data @

z6=data[8:212,8];     @ Nixon dummies @
z7=data[8:212,9];     @ demeaned supply shock @

zz=z0~z1~z2~z3~z4~z5~z6~z7;

t=rows(zz);
format /m1 /rd 6,3;
output file=c:\arabinda\research\prod\program01.out reset;
output off;

@================= Initialize Global Variables============@

         START=1;       @ 1955.1--2006.1 @
         PRMTR_NO=30;   @ Number of parameters to be estimated @
         St_var=6;      @ Number of state equations @

pr_1=-1.3;
pr_2=-0.0;pr_3=-1.5;
pr_4=0.0;pr_5=-0.0;pr_6=-1.5;
pr_7=0.0;pr_8=-0.0;pr_9=-0.0;pr_10=-1.6;
pr_11=0.0;pr_12=-0.0;pr_13=-0.0;pr_14=0.0;pr_15=-2.2;

pr_16=0.3; pr_17=-0.2;
pr_18=0.5;pr_19=-0.0;

pr_20=2.0;pr_21=-0.7; 

pr_22=-1.0;

pr_23=0.5;pr_24=0.5;
pr_25=0.2;pr_26=0.5;pr_27=-0.7;pr_28=-0.1; 
pr_29=0.0;pr_30=0.3;

           @ initial values of parameters @

PRMTR_IN=pr_1|pr_2|pr_3|pr_4|pr_5|pr_6|pr_7|pr_8|pr_9|pr_10|pr_11|pr_12|
pr_13|pr_14|pr_15|pr_16|pr_17|pr_18|pr_19|pr_20|pr_21|pr_22|pr_23|pr_24|
pr_25|pr_26|pr_27|pr_28|pr_29|pr_30;

@ Maximum Likelihood Estimation @
_opusrgd = &gradfd;

 {xout,fout,gout,cout}=optmum(&lik_fcn,PRMTR_IN);

  @ prmtr estimates, -log lik value, Gradient, Hessian@

  hout=inv(hessp(&lik_fcn,xout));

PRM_FNL=trans(xout);   @ Estimated  coefficients, constrained@

grdn_fnl=gradfd(&TRANS,xout);
Hsn_fnl=grdn_fnl*hout*grdn_fnl';
SD_fnl =sqrt(diag(Hsn_fnl)); @ Std errors est. coeffs @

PM_FNL=trans1(xout);   @ Estimated std dev/corr coefficients, constrained @

grd_fnl=gradfd(&TRANS1,xout[1:15,1]);
Hs_fnl=grd_fnl*hout[1:15,1:15]*grd_fnl';
Std_fnl = sqrt(diag(Hs_fnl));

output on;
"==FINAL OUTPUT=============================================";
"The Likelihood value is ";; -fout;
"The code is ";; cout;
"Estimated parameters are:";
prm_fnl';
"Estimated parameters without transformation:";
XOUT';
"Standard errors of parameters are:"; sd_fnl';

"The standard deviations are:"; pm_fnl[1:5,1]';
"The standard errors:"; std_fnl[1:5,1]';

"The other correlations:"; pm_fnl[6:15,1]';
"The standard errors:"; std_fnl[6:15,1]';

"The hout matrix is:";hout;

"===============================================================";
output off;

{sv1,var1}=SAVE_OUT(xout);

sv_sm = smoothkf(xout);

OUTPUT FILE=c:\arabinda\research\prod\program01a.out RESET;
sv_sm; OUTPUT OFF;

@=====================================================================@
@=====================================================================@
PROC LIK_FCN(PRMTR1);

local BETA_TT,P_TT,QQ,LIK,J_ITER,XT,BETA_TL,P_TL,SS,phi,SIG,ZT,B,K_GAIN,CH_M,AA,lam,
      mu_p0,mu_p1,mu_p2,mu_h0,mu_h1,mu_h2,c_1,c_2,cp_1,cp_2,co_1,co_2,cw_1,TW_0,TW_1,
      a11,a21,a22,a31,a32,a33,a41,a42,a43,a44,a51,a52,a53,a54,a55,a61,a62,a63,a64,a65,a66,
      b_0,b_1,c1,c2,c3,c4,c5,c6,
      F_CAST,F,BETA_LL,P_LL,RR,
      YT,H,A,phi1,GAM1,GAM2,prmtr,QQ1,F1,vecp,beta;

EXTERNAL PROC TRANS;

           PRMTR=TRANS(PRMTR1);

        a11=pRMTR[1,1];
        a21=PRMTR[2,1];
        a22=prmtr[3,1];
        a31=prmtr[4,1];
        a32=prmtr[5,1];
        a33=prmtr[6,1];
	    a41=pRMTR[7,1];
        a42=PRMTR[8,1];
        a43=prmtr[9,1];
        a44=prmtr[10,1];
        a51=prmtr[11,1];
        a52=prmtr[12,1];
	    a53=prmtr[13,1];
        a54=prmtr[14,1];
	    a55=pRMTR[15,1];
       

        GAM1=PRMTR[16,1];
	GAM2=PRMTR[17,1];

        mu_p0=prmtr[18,1];	   
	mu_h0=prmtr[19,1];
 
        c_1=PRMTR[20,1];
        c_2=prmtr[21,1];

	    cp_1=PRMTR[22,1];
	    
        b_0=prmtr[23,1];
        b_1=prmtr[24,1];
        
        c1=prmtr[25,1];
        c2=prmtr[26,1];
  	    c3=prmtr[27,1];
        c4=prmtr[28,1];
	    c5=prmtr[29,1];	
        c6=prmtr[30,1];	

H = (1~0~0~0~1~0)|(0~1~1~0~0~0)|(0~0~gam1~0~gam2~1);

F = (1~0~0~0~0~0)|(0~1~0~0~0~0)|(0~0~c_1~c_2~0~0)|
    (0~0~1~0~0~0)|(0~0~0~0~cp_1~0)|(0~0~0~0~0~0);

F1= F[3:6,3:6];

A = (mu_p0~0~0~0~0~0~0~0)|(mu_h0~0~0~0~0~0~0~0)|
    (0~0~0~0~0~0~0~0)|(0~0~0~0~0~0~0~0)|
    (0~0~0~0~0~0~0~0)|(b_0~c1~c2~c3~c4~b_1~c5~c6);

AA = (a11~0~0~0~0)|(a21~a22~0~0~0)|(a31~a32~a33~0~0)|
     (a41~a42~a43~a44~0)|(a51~a52~a53~a54~a55);
CH_M = AA*AA';

RR = (1~0~0~0~0)|(0~1~0~0~0)|(0~0~1~0~0)|(0~0~0~0~0)|
     (0~0~0~1~0)|(0~0~0~0~1);

QQ =  RR*CH_M*RR';

QQ1= QQ[3:6,3:6];

     BETA_LL = (data[7,1]|data[7,2]|0|0|0|data[6,3]);
@ initial guess for state from 1954:4 measure @

     P_ll = zeros(6,6);
     vecp = inv(eye(16)-f1.*.f1)*vec(QQ1); @ uncertain  initial guess @
     P_LL[3:6,3:6] = reshape(vecp,4,4);
     p_ll[1,1] = 100;
     p_ll[2,2] = 100;

@ Starting iteration for the filter @
LIK=0.0;
J_ITER = 1;
DO UNTIL J_ITER > T;

      YT= YY[J_ITER,.];
      ZT= ZZ[J_ITER,.];

      BETA_TL = A*ZT' + F * BETA_LL;
      P_TL = F * P_LL * F' +  QQ ;

      F_CAST = YT'  -  H * BETA_TL;
      SS = H * P_TL * H' ;

      BETA_TT = BETA_TL + (P_TL*H'*inv(SS)) * F_CAST;
      P_TT = (EYE(6) - (P_TL*H'*inv(SS))* H ) * P_TL;

      BETA_LL=BETA_TT;  P_LL=P_TT;

      IF J_ITER < START; goto skip; endif;

     LIK = LIK+ 0.5*3*(LN(2*pi))+ 0.5*ln(det(SS)) + 0.5*((F_CAST'*inv(SS)*f_cast));


skip:  J_ITER = J_ITER+1;
ENDO;

RETP(LIK);
ENDP;

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

PROC(2) = SAVE_OUT(PRMTR1);

local BETA_TT, P_TT, QQ, LIK, J_ITER, XT, BETA_TL, P_TL, SS,
      K_GAIN,zt,B,CH_M,AA,lam,F_CAST, RR,F, BETA_LL, P_LL,
      mu_p0,mu_p1,mu_p2,mu_h0,mu_h1,mu_h2,c_1,c_2,cp_1,cp_2,co_1,co_2,cw_1,TW_0,TW_1,
      a11,a21,a22,a31,a32,a33,a41,a42,a43,a44,a51,a52,a53,a54,a55,a61,a62,a63,a64,a65,a66,
      b_0,b_1,c1,c2,c3,c4,c5,c6,
      YT, H,A,phi1,GAM1,GAM2,prmtr,vecp,F1,QQ1,DTA_MAT,P_MAT,beta;

EXTERNAL PROC TRANS;

           PRMTR=TRANS(PRMTR1);

         a11=pRMTR[1,1];
        a21=PRMTR[2,1];
        a22=prmtr[3,1];
        a31=prmtr[4,1];
        a32=prmtr[5,1];
        a33=prmtr[6,1];
	    a41=pRMTR[7,1];
        a42=PRMTR[8,1];
        a43=prmtr[9,1];
        a44=prmtr[10,1];
        a51=prmtr[11,1];
        a52=prmtr[12,1];
	    a53=prmtr[13,1];
        a54=prmtr[14,1];
	    a55=pRMTR[15,1];
       

        GAM1=PRMTR[16,1];
	GAM2=PRMTR[17,1];

       mu_p0=prmtr[18,1];	   
	mu_h0=prmtr[19,1];
 
        c_1=PRMTR[20,1];
        c_2=prmtr[21,1];

	    cp_1=PRMTR[22,1];
	    
        b_0=prmtr[23,1];
        b_1=prmtr[24,1];
        
        c1=prmtr[25,1];
        c2=prmtr[26,1];
  	    c3=prmtr[27,1];
        c4=prmtr[28,1];
	    c5=prmtr[29,1];	
        c6=prmtr[30,1];	

H = (1~0~0~0~1~0)|(0~1~1~0~0~0)|(0~0~gam1~0~gam2~1);

F = (1~0~0~0~0~0)|(0~1~0~0~0~0)|(0~0~c_1~c_2~0~0)|
    (0~0~1~0~0~0)|(0~0~0~0~cp_1~0)|(0~0~0~0~0~0);

F1= F[3:6,3:6];

A = (mu_p0~0~0~0~0~0~0~0)|(mu_h0~0~0~0~0~0~0~0)|
    (0~0~0~0~0~0~0~0)|(0~0~0~0~0~0~0~0)|
    (0~0~0~0~0~0~0~0)|(b_0~c1~c2~c3~c4~b_1~c5~c6);

AA = (a11~0~0~0~0)|(a21~a22~0~0~0)|(a31~a32~a33~0~0)|
     (a41~a42~a43~a44~0)|(a51~a52~a53~a54~a55);
CH_M = AA*AA';

RR = (1~0~0~0~0)|(0~1~0~0~0)|(0~0~1~0~0)|(0~0~0~0~0)|
     (0~0~0~1~0)|(0~0~0~0~1);

QQ =  RR*CH_M*RR';

QQ1= QQ[3:6,3:6];

     BETA_LL = (data[7,1]|data[7,2]|0|0|0|data[6,3]);
@ initial guess for state from 1954:4 measure @

     P_ll = zeros(6,6);
     vecp = inv(eye(16)-f1.*.f1)*vec(QQ1); @ uncertain  initial guess @
     P_LL[3:6,3:6] = reshape(vecp,4,4);
     p_ll[1,1] = 100;
     p_ll[2,2] = 100;

dta_mat=zeros(t,6);
P_MAT=zeros(t,36);

@ Starting iteration for the filter @
LIK=0.0;
J_ITER = 1;
DO UNTIL J_ITER>T;

      YT=YY[J_ITER,.];
      ZT=ZZ[J_ITER,.];

      BETA_TL = A*ZT' + F * BETA_LL;
      P_TL = F * P_LL * F' + QQ ;

      F_CAST = YT'  - H * BETA_TL;
      SS = H * P_TL * H' ;

      BETA_TT = BETA_TL + (P_TL*H'*inv(SS)) * F_CAST;
      P_TT = (EYE(6) - (P_TL*H'*inv(SS))* H ) * P_TL;

      BETA_LL=BETA_TT;  P_LL=P_TT;

      DTA_MAT[J_ITER,1:6]=BETA_TT[1:6,.]';
      p_mat[j_iter,.]=vec(P_TT)';
     
  J_ITER = J_ITER+1;
  ENDO;


RETP(dta_mat,P_MAT);
ENDP;
@-------------------------------------------------------------------@
proc trans(c0);
local cc, d0, d1, d2,d3 ;
cc = c0;


d0 =c0[20,1]./(1+abs(c0[20,1]));
d1 =(1-abs(d0))*c0[21,1]./(1+abs(c0[21,1]))+ abs(d0)-d0^2;

     cc[20,1]=2*d0;
     cc[21,1]=-1*(d0^2 + d1) ;

cc[22,1] = (exp(-1*c0[22,1]) - 1)/(1 + exp(-1*c0[22,1]));

retp(cc);
endp;

@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
proc trans1(c_0);

local c_c, mat1, mat2;

c_c = c_0[1:15,1];

mat1 = (c_0[1,1]~0~0~0~0)|(c_0[2,1]~c_0[3,1]~0~0~0)|
(c_0[4,1]~c_0[5,1]~c_0[6,1]~0~0)|(c_0[7,1]~c_0[8,1]~c_0[9,1]~c_0[10,1]~0)|
(c_0[11,1]~c_0[12,1]~c_0[13,1]~c_0[14,1]~c_0[15,1]);

mat2 = mat1 * mat1';

c_c[1,1] = sqrt(mat2[1,1]);
c_c[2,1] = sqrt(mat2[2,2]);
c_c[3,1] = sqrt(mat2[3,3]);
c_c[4,1] = sqrt(mat2[4,4]);
c_c[5,1] = sqrt(mat2[5,5]);

c_c[6,1] = (mat2[2,1])/((sqrt(mat2[1,1]))*(sqrt(mat2[2,2]))); @ prod trend - hour trend corr @

c_c[7,1] = (mat2[3,1])/((sqrt(mat2[1,1]))*(sqrt(mat2[3,3]))); @ prod trend - hour cyc corr @
c_c[8,1] = (mat2[3,2])/((sqrt(mat2[2,2]))*(sqrt(mat2[3,3]))); @ hour trend - hour cyc corr @

c_c[9,1] = (mat2[4,1])/((sqrt(mat2[1,1]))*(sqrt(mat2[4,4]))); @ prod trend - prod cyc corr @
c_c[10,1] = (mat2[4,2])/((sqrt(mat2[2,2]))*(sqrt(mat2[4,4]))); @ hour trend - prod cyc corr @
c_c[11,1] = (mat2[4,3])/((sqrt(mat2[3,3]))*(sqrt(mat2[4,4]))); @ hours cyc - prod cyc corr @

c_c[12,1] = (mat2[5,1])/((sqrt(mat2[1,1]))*(sqrt(mat2[5,5]))); @ prod trend - inf corr @
c_c[13,1] = (mat2[5,2])/((sqrt(mat2[2,2]))*(sqrt(mat2[5,5]))); @ hour trend - inf corr @
c_c[14,1] = (mat2[5,3])/((sqrt(mat2[3,3]))*(sqrt(mat2[5,5]))); @ hour cyc - inf cyc corr @
c_c[15,1] = (mat2[5,4])/((sqrt(mat2[4,4]))*(sqrt(mat2[5,5]))); @ prod cyc - inf cyc corr @


retp(c_c);
endp;
@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@

@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
proc smoothkf(prmtr1);

local mu_p0,mu_p1,mu_p2,mu_h0,mu_h1,mu_h2,c_1,c_2,cp_1,cp_2,co_1,co_2,cw_1,TW_0,TW_1,
      a11,a21,a22,a31,a32,a33,a41,a42,a43,a44,a51,a52,a53,a54,a55,a61,a62,a63,a64,a65,a66,
      b_0,b_1,c1,c2,c3,c4,c5,c6,
      H,A,AA,QQ,RR,jj,yt,zt,mat,ppt,k1,k2,k3,ptt,vtt,vtt1,kk1,kk2,CH_M,
      gam1,gam2,pstar,aat,aal,prmtr,F,vt,vv,vv1,sv,p_tl;

EXTERNAL PROC TRANS;

           PRMTR=TRANS(PRMTR1);

        a11=pRMTR[1,1];
        a21=PRMTR[2,1];
        a22=prmtr[3,1];
        a31=prmtr[4,1];
        a32=prmtr[5,1];
        a33=prmtr[6,1];
	    a41=pRMTR[7,1];
        a42=PRMTR[8,1];
        a43=prmtr[9,1];
        a44=prmtr[10,1];
        a51=prmtr[11,1];
        a52=prmtr[12,1];
	    a53=prmtr[13,1];
        a54=prmtr[14,1];
	    a55=pRMTR[15,1];
       

        GAM1=PRMTR[16,1];
	GAM2=PRMTR[17,1];

	mu_p0=prmtr[18,1];	   
	mu_h0=prmtr[19,1];
 
        c_1=PRMTR[20,1];
        c_2=prmtr[21,1];

	    cp_1=PRMTR[22,1];
	    
        b_0=prmtr[23,1];
        b_1=prmtr[24,1];
        
        c1=prmtr[25,1];
        c2=prmtr[26,1];
  	    c3=prmtr[27,1];
        c4=prmtr[28,1];
	    c5=prmtr[29,1];	
        c6=prmtr[30,1];	

H = (1~0~0~0~1~0)|(0~1~1~0~0~0)|(0~0~gam1~0~gam2~1);

F = (1~0~0~0~0~0)|(0~1~0~0~0~0)|(0~0~c_1~c_2~0~0)|
    (0~0~1~0~0~0)|(0~0~0~0~cp_1~0)|(0~0~0~0~0~0);

A = (mu_p0~0~0~0~0~0~0~0)|(mu_h0~0~0~0~0~0~0~0)|
    (0~0~0~0~0~0~0~0)|(0~0~0~0~0~0~0~0)|
    (0~0~0~0~0~0~0~0)|(b_0~c1~c2~c3~c4~b_1~c5~c6);

AA = (a11~0~0~0~0)|(a21~a22~0~0~0)|(a31~a32~a33~0~0)|
     (a41~a42~a43~a44~0)|(a51~a52~a53~a54~a55);
CH_M = AA*AA';

RR = (1~0~0~0~0)|(0~1~0~0~0)|(0~0~1~0~0)|(0~0~0~0~0)|
     (0~0~0~1~0)|(0~0~0~0~1);

QQ =  RR*CH_M*RR';


mat=zeros(t,6);

mat[t,1:6]=sv1[t,1:6];

aat=zeros(t,6);
ptt=zeros(t,1);
vtt=zeros(t,36);
sv=zeros(t,6);
sv[.,1:6]=sv1[.,1:6];

aat[t,1:6]=sv1[t,1:6];

vtt[t,.]=(vec(reshape(var1[t,.],6,6)))';

jj=t-1;
do until jj<1;

    yt=yy[jj,.];
    zt=zz[jj,.];
    vv=var1[jj,.]';
    vt=reshape(vv,6,6);
    
p_tl= F*vt*F' + QQ;

pstar=vt*F'*inv(p_tl);

aat[jj,.]=(sv[jj,.]' + pstar*(aat[jj+1,.]'-F*sv[jj,.]'-A*ZT'))';

vtt[jj,.]=(vec(vt+pstar*(reshape(vtt[jj+1,.]',6,6)-p_tl)*pstar'))';

vtt1=reshape(vtt[jj,.],6,6);

mat[jj,1:6]=aat[jj,1:6];

jj=jj-1;

endo;

retp(mat);

endp;

@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@

END;
@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@

