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

/*** This program calculates the UC model with VAR restrictions in the 
levels data of hours per capita. The number of lags used is 4.

We have 3 measurement equations, 5 transitory equations and 32 parameters. 

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;

prdg1 = data[7:211,1] - data[6:210,1];
prdg2 = data[6:210,1] - data[5:209,1];
prdg3 = data[5:209,1] - data[4:208,1];
prdg4 = data[4:208,1] - data[3:207,1];

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 @

z8=prdg1-meanc(prdg1);	 @ 1 lag demeaned productivity growth @
z9=prdg2-meanc(prdg2);   @ 2 lag demeaned productivity growth @
z10=prdg3-meanc(prdg3);	 @ 3 lag demeaned productivity growth @
z11=prdg4-meanc(prdg4);  @ 4 lag demeaned productivity growth @

z12=data[7:211,2]-meanc(data[7:211,2]); @ 1 lag demeaned hours per capita @ 
z13=data[6:210,2]-meanc(data[6:210,2]); @ 2 lag demeaned hours per capita @ 
z14=data[5:209,2]-meanc(data[5:209,2]); @ 3 lag demeaned hours per capita @ 
z15=data[4:208,2]-meanc(data[4:208,2]); @ 4 lag demeaned hours per capita @ 

zz=z0~z1~z2~z3~z4~z5~z6~z7~z8~z9~z10~z11~z12~z13~z14~z15;

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

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

         START=1;       @ 1955.1--2005.2 @
         PRMTR_NO=32;   @ Number of parameters to be estimated @
         St_var=5;      @ Number of state equations @

pr_1=-1.3;
pr_2=-1.5;
pr_3=-2.4;

pr_4=0.0;pr_5=0.5;pr_6=-0.1;pr_7=0.0;

pr_8=0.5;

pr_9=0.5;pr_10=0.5;
pr_11=0.2;pr_12=0.5;pr_13=-0.7;pr_14=-0.1; 
pr_15=0.0;pr_16=0.3;
pr_17=0.2;pr_18=0.1;pr_19=0.0;pr_20=0.05;
pr_21=0.1;pr_22=0.0;pr_23=0.09;pr_24=0.02;
pr_25=0.3;pr_26=0.1;pr_27=0.05;pr_28=-0.03;
pr_29=0.2;pr_30=-0.05;pr_31=-0.04;pr_32=0.06;


           @ 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|pr_31|pr_32;

@ 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:3,1]);
Hs_fnl=grd_fnl*hout[1:3,1:3]*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:3,1]';
"The standard errors:"; std_fnl[1:3,1]';

"The hout matrix is:";hout;

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

{sv1,var1}=SAVE_OUT(xout);

@ sv_sm = smoothkf(xout); @
OUTPUT FILE=c:\arabinda\research\prod\program03a.out RESET;
sv1; 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,d1,d2,d3,d4,
      F_CAST,F,BETA_LL,P_LL,RR,hp1,hp2,hp3,hp4,hh1,hh2,hh3,hh4,ph1,ph2,ph3,ph4,pp1,pp2,pp3,pp4,
      YT,H,A,phi1,GAM1,GAM2,prmtr,QQ1,F1,vecp,beta;

EXTERNAL PROC TRANS;

           PRMTR=TRANS(PRMTR1);

        a11=pRMTR[1,1];        
        a22=prmtr[2,1];      
        a33=prmtr[3,1];

        d1=PRMTR[4,1];
        d2=prmtr[5,1];
        d3=PRMTR[6,1];
        d4=prmtr[7,1];

        mu_p0=prmtr[8,1];	   
	 
        b_0=prmtr[9,1];
        b_1=prmtr[10,1];
        
        c1=prmtr[11,1];
        c2=prmtr[12,1];
  	    c3=prmtr[13,1];
        c4=prmtr[14,1];
	    c5=prmtr[15,1];	
        c6=prmtr[16,1];	
        
        hp1=prmtr[17,1];	
        hp2=prmtr[18,1];	
        hp3=prmtr[19,1];	
        hp4=prmtr[20,1];	

        hh1=prmtr[21,1];	
        hh2=prmtr[22,1];	
        hh3=prmtr[23,1];	
        hh4=prmtr[24,1];

        ph1=prmtr[25,1];	
        ph2=prmtr[26,1];	
        ph3=prmtr[27,1];	
        ph4=prmtr[28,1];
  
	pp1=prmtr[29,1];	
        pp2=prmtr[30,1];	
        pp3=prmtr[31,1];	
        pp4=prmtr[32,1];

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

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

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

A = (mu_p0~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)|
    (0~0~0~0~0~0~0~0~hp1~hp2~hp3~hp4~hh1~hh2~hh3~hh4)|
    (0~0~0~0~0~0~0~0~pp1~pp2~pp3~pp4~ph1~ph2~ph3~ph4)|
    (b_0~c1~c2~c3~c4~b_1~c5~c6~0~0~0~0~0~0~0~0);

AA = (a11~0~0)|(0~a22~0)|(0~0~a33);
CH_M = AA*AA';

RR = (1~0~0)|(0~0~0)|(d1~1~0)|(0~d2~0)|(d3~d4~1);

QQ =  RR*CH_M*RR';

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

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

     P_ll = zeros(5,5);
     vecp = inv(eye(9)-f1.*.f1)*vec(QQ1); @ uncertain  initial guess @
     P_LL[3:5,3:5] = reshape(vecp,3,3);
     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(5) - (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,d1,d2,d3,d4,
      hp1,hp2,hp3,hp4,hh1,hh2,hh3,hh4,ph1,ph2,ph3,ph4,pp1,pp2,pp3,pp4,
      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];        
        a22=prmtr[2,1];      
        a33=prmtr[3,1];

        d1=PRMTR[4,1];
        d2=prmtr[5,1];
        d3=PRMTR[6,1];
        d4=prmtr[7,1];

        mu_p0=prmtr[8,1];	   
	 
        b_0=prmtr[9,1];
        b_1=prmtr[10,1];
        
        c1=prmtr[11,1];
        c2=prmtr[12,1];
  	    c3=prmtr[13,1];
        c4=prmtr[14,1];
	    c5=prmtr[15,1];	
        c6=prmtr[16,1];	
        
        hp1=prmtr[17,1];	
        hp2=prmtr[18,1];	
        hp3=prmtr[19,1];	
        hp4=prmtr[20,1];	

        hh1=prmtr[21,1];	
        hh2=prmtr[22,1];	
        hh3=prmtr[23,1];	
        hh4=prmtr[24,1];

        ph1=prmtr[25,1];	
        ph2=prmtr[26,1];	
        ph3=prmtr[27,1];	
        ph4=prmtr[28,1];
  
	pp1=prmtr[29,1];	
        pp2=prmtr[30,1];	
        pp3=prmtr[31,1];	
        pp4=prmtr[32,1];

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

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

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

A = (mu_p0~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)|
    (0~0~0~0~0~0~0~0~hp1~hp2~hp3~hp4~hh1~hh2~hh3~hh4)|
    (0~0~0~0~0~0~0~0~pp1~pp2~pp3~pp4~ph1~ph2~ph3~ph4)|
    (b_0~c1~c2~c3~c4~b_1~c5~c6~0~0~0~0~0~0~0~0);

AA = (a11~0~0)|(0~a22~0)|(0~0~a33);
CH_M = AA*AA';

RR = (1~0~0)|(0~0~0)|(d1~1~0)|(0~d2~0)|(d3~d4~1);

QQ =  RR*CH_M*RR';

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

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

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

dta_mat=zeros(t,5);
P_MAT=zeros(t,25);

@ 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(5) - (P_TL*H'*inv(SS))* H ) * P_TL;

      BETA_LL=BETA_TT;  P_LL=P_TT;

      DTA_MAT[J_ITER,1:5]=BETA_TT[1:5,.]';
      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;


retp(cc);
endp;

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


proc trans1(c_0);

local c_c, mat1, mat2;

c_c = c_0[1:3,1];

mat1 = (c_0[1,1]~0~0)|(0~c_0[2,1]~0)|(0~0~c_0[3,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]);

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,d1,d2,d3,d4,h1,h2,h3,h4,
      hp1,hp2,hp3,hp4,hh1,hh2,hh3,hh4,ph1,ph2,ph3,ph4,pp1,pp2,pp3,pp4,
      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,QQ1,F1,A1;

EXTERNAL PROC TRANS;

           PRMTR=TRANS(PRMTR1);

       a11=pRMTR[1,1];        
        a22=prmtr[2,1];      
        a33=prmtr[3,1];

        d1=PRMTR[4,1];
        d2=prmtr[5,1];
        d3=PRMTR[6,1];
        d4=prmtr[7,1];

        mu_p0=prmtr[8,1];	   
	 
        b_0=prmtr[9,1];
        b_1=prmtr[10,1];
        
        c1=prmtr[11,1];
        c2=prmtr[12,1];
  	    c3=prmtr[13,1];
        c4=prmtr[14,1];
	    c5=prmtr[15,1];	
        c6=prmtr[16,1];	
        
        hp1=prmtr[17,1];	
        hp2=prmtr[18,1];	
        hp3=prmtr[19,1];	
        hp4=prmtr[20,1];	

        hh1=prmtr[21,1];	
        hh2=prmtr[22,1];	
        hh3=prmtr[23,1];	
        hh4=prmtr[24,1];

        ph1=prmtr[25,1];	
        ph2=prmtr[26,1];	
        ph3=prmtr[27,1];	
        ph4=prmtr[28,1];
  
	pp1=prmtr[29,1];	
        pp2=prmtr[30,1];	
        pp3=prmtr[31,1];	
        pp4=prmtr[32,1];


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

A = (mu_p0~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)|
    (0~0~0~0~0~0~0~0~hp1~hp2~hp3~hp4~hh1~hh2~hh3~hh4)|
    (0~0~0~0~0~0~0~0~pp1~pp2~pp3~pp4~ph1~ph2~ph3~ph4)|
    (b_0~c1~c2~c3~c4~b_1~c5~c6~0~0~0~0~0~0~0~0);

AA = (a11~0~0)|(0~a22~0)|(0~0~a33);
CH_M = AA*AA';

RR = (1~0~0)|(0~0~0)|(d1~1~0)|(0~d2~0)|(d3~d4~1);

QQ =  RR*CH_M*RR';

let k1 = 1 3 4 5;
let k2 = 1 3 4 5;

F1=submat(F, k1, k2);
QQ1=submat(QQ, k1, k2);
A1=submat(A, k1,0);

mat=zeros(t,4);

mat[t,1]=sv1[t,1];
mat[t,2:4]=sv1[t,3:5];

aat=zeros(t,4);
ptt=zeros(t,1);
vtt=zeros(t,16);
sv=zeros(t,4);
sv[.,1]=sv1[.,1];
sv[.,2:4]=sv1[.,3:5];

aat[t,1]=sv1[t,1];
aat[t,2:4]=sv1[t,3:5];

vtt[t,.] = (vec(submat(reshape(var1[t,.],5,5), k1,k2)))';

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

    yt=yy[jj,.];
    zt=zz[jj,.];
    vv=var1[jj,.]';
    vv1=reshape(vv,5,5);
    vt=submat(vv1,k1,k2);
    
p_tl= F1*vt*F1' + QQ1;

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

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

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

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

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

jj=jj-1;

endo;

retp(mat);

endp;
***/
@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@

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

