new;

/*
** This code was written by Joakim Westerlund, Department of Economics,
** Lund University, Sweden.
** E-mail: joakim.westerlund@nek.lu.se
** 
** The code can be used freely as long as proper reference is given. No
** performance guarantee is made. Bug reports are welcome.
*/


k    = ?;                       /* no of regressors */
t    = ?;                       /* no of time series */
n    = ?;                       /* no of cross-sections */
kmax = 5;                       /* max factors */
p    = int(4*(t/100)^(2/9));    /* bandwidth */

load x[t,n*k] = c:\?;           /* t x nk matrix */
load y[t,n]   = c:\?;           /* t x n matrix */



i       = 1; 
dhg     = 0;
{e,nf}  = cum(x,y,kmax);
do until i > n;

dhg = dhg + gdh(e[.,i],p);

i = i + 1;
endo;

mu  = 5.5464;
var = 36.7673;
dhg = sqrt(n)*(dhg/n-mu)/sqrt(var);

mu  = 0.5005;
var = 0.3348;
dhp = sqrt(n)*(pdh(e,p)/n-mu^(-1))/sqrt(mu^(-4)*var);   




    
/* printing options */
format/m1/rd 8,3;

print " ";
print " dh_g = ";; dhg;
print " dh_p = ";; dhp;






/* procs */


proc (2) = cum(x,y,kmax);
local t,n,k,i,e,de,dy,dx,dyi,dxi,nf,f,lam;

t   = rows(y);
n   = cols(y);
k   = cols(x)/n;

i  = 1;
de = zeros(t,n);
y  = zeros(1,n)|y;
x  = zeros(1,k*n)|x;
dy = diff(y,1);
dx = diff(x,1);
do until i > n;

dyi     = dy[.,i];
dxi     = dx[.,1+(i-1)*k:i*k];
de[.,i] = (eye(t) - dxi*inv(dxi'dxi)*dxi')*dyi;  

i = i + 1;
endo;

nf      = fact(de,kmax);   
{f,lam} = prin(de,nf);
de      = de - f*lam';
e       = cumsumc(de);

retp(e,nf);
endp;


proc (1) = gdh(w,p);
local t,w0,wl,v,m,b1,b2,e,s,dh;

t  = rows(w);

wl = w[1:t-1];
w0 = w[2:t];

b1 = inv(wl'wl)*(wl'w0);
b2 = inv(wl'w0)*(w0'w0);
e  = w0 - wl*b1;
s  = (lrvar("sig",e,p))^2/lrvar("ome",e,p);
dh = (b2 - b1)^2/(s*inv(wl'wl));

retp(dh);
endp;


proc (1) = pdh(w,p);
local t,n,w0,wl,v,m,b1,b2,e,s,o,dh;

t  = rows(w);
n  = cols(w);

w  = w[.,2:cols(w)]; 
wl = w[1:t-1,.];
w0 = w[2:t,.];
wl = vec(wl);
w0 = vec(w0);

b1 = inv(wl'wl)*(wl'w0);
b2 = inv(wl'w0)*(w0'w0);

i  = 1;
s  = 0;
o  = 0;
e  = reshape((w0-wl*b1),n,t-1)';
do until i > n;

s = s + lrvar("sig",e[.,i],p);	                
o = o + lrvar("ome",e[.,i],p);

i = i + 1;
endo;

dh = ((o/n)*(b2 - b1)^2)/(((s/n)^2)*inv(wl'wl));

retp(dh);
endp;


proc (1) = lrvar(x,u,l);
local v0,vl,s;

v0 = fejer(u,0);
vl = fejer(u,l); 

if x $== "sig"; s = v0;              endif;
if x $== "del"; s = (v0 + vl)';      endif;
if x $== "ome"; s = v0 + vl + vl';   endif;

retp(s);
endp;


proc (1) = lagn(x,n);
local y;
y = shiftr(x',n,(miss(0,0))');
retp(y');
endp;


proc (1) = diff(x,k);
if k == 0;
retp(x);
endif;
retp(trimr(x,k,0)-trimr(lagn(x,k),k,0));
endp;


proc (1) = fact(e,nf);
local t,n,cr,k,s,smax,u,f,lam;

t       = rows(e);
n       = cols(e);   
{f,lam} = prin(e,nf);
u       = e - f*lam';
smax    = sumc(sumc(u.^2))/(n*t);

k    = 1;
cr   = zeros(nf,1);  
do while k <= nf;

{f,lam} = prin(e,k);
u       = e - f*lam';
s       = sumc(sumc(u.^2))/(n*t);
cr[k]   = log(s) + k*((n+t)/(n*t)*log(minc(n|t)));

k = k + 1;
endo;

cr = sortc(seqa(1,1,rows(cr))~cr,2);

retp(cr[1,1]);
endp;


proc (2) = prin(e,nf);
local t,n,f0,v,f,lam;

t = rows(e);
n = cols(e);

if n > t;
{f0,v,f}  = svd1(e*e');
f         = f0[.,1:nf]*sqrt(t);
lam       = (e'f)/t;
else;

{f0,v,f}  = svd1(e'e);
lam       = f0[.,1:nf]*sqrt(n);
f         = (e*lam)/n;
endif;

retp(f,lam);
endp;


proc (1) = fejer(u,k);
local i,w,s,u0,ul;

if k == 0; s = u'u; goto out; endif;

i = 1;
s = 0;
do until i > k;
w  = 1 - i/(k+1);
u0 = trimr(u,i,0);
ul = trimr(lagn(u,i),i,0);
s  = s + w*(u0'ul);
i  = i + 1;
endo;

out:

retp(s/rows(u));
endp;
