293 lines
7.3 KiB
Scilab
293 lines
7.3 KiB
Scilab
|
function [dr]=dr1(iorder,dr,correct)
|
||
|
// Copyright (C) 2001 Michel Juillard
|
||
|
//
|
||
|
|
||
|
xlen = xkmax_+xkmin_+1;
|
||
|
klen = ykmin_+ykmax_+1;
|
||
|
iyv = iy_';
|
||
|
iyv = iyv(:);
|
||
|
iyr0 = find(iyv)';
|
||
|
it_ = ykmin_+1;
|
||
|
|
||
|
|
||
|
if exo_nbr==0 then
|
||
|
exe_ = [];
|
||
|
end
|
||
|
|
||
|
if ~(iy_(ykmin_+1,:)>0) then
|
||
|
error('Error in model specification: some variables don""t appear as current');
|
||
|
end
|
||
|
|
||
|
if ykmax_==0 then
|
||
|
error('No forward variable: no point in using dr1');
|
||
|
end
|
||
|
|
||
|
if xlen>1 then
|
||
|
error('SS: stochastic exogenous variables must appear only at the'+' current period. Use additional endogenous variables');
|
||
|
end
|
||
|
|
||
|
tempex = ex_;
|
||
|
|
||
|
it_ = ykmin_+1;
|
||
|
|
||
|
z = dr('ys')*ones(1,klen);
|
||
|
z = z(iyr0);
|
||
|
|
||
|
jacobia_ = real(jacob_a('ff1_',[z;exe_]));
|
||
|
|
||
|
ex_ = tempex;
|
||
|
tempex = [];
|
||
|
|
||
|
nz = size(z,1);
|
||
|
pred_var = find(or(iy_(1:ykmin_,:),1));
|
||
|
|
||
|
fwrd_var = find(or(iy_(ykmin_+2:ykmin_+ykmax_+1,:),1));
|
||
|
both_var = intersect(pred_var,fwrd_var);
|
||
|
if size(both_var,'*')
|
||
|
pred_var = setdiff(pred_var,both_var);
|
||
|
fwrd_var = setdiff(fwrd_var,both_var);
|
||
|
end
|
||
|
nboth = length(both_var);
|
||
|
npred = length(pred_var);
|
||
|
nfwrd = length(fwrd_var);
|
||
|
stat_var = setdiff(1:endo_nbr,union(union(pred_var,both_var),fwrd_var));
|
||
|
nstatic = length(stat_var);
|
||
|
order_var = [stat_var,pred_var,both_var,fwrd_var];
|
||
|
k1 = iy_(find((1:klen)~=(ykmin_+1)),:);
|
||
|
b = jacobia_(:,iy_(ykmin_+1,order_var));
|
||
|
a = b\jacobia_(:,nonzeros(k1'));
|
||
|
if exo_nbr then
|
||
|
fu = b\jacobia_(:,nz+1:size(jacobia_,2));
|
||
|
end
|
||
|
|
||
|
// building kmask for z state vector in t+1
|
||
|
if ykmin_>0 then
|
||
|
if ykmax_>0 then
|
||
|
%v2 = iy_(ykmin_+2:size(iy_,1),order_var)
|
||
|
kmask = cumsum(%v2($:-1:1,:),1);
|
||
|
%v2 = cumsum(iy_(1:ykmin_,order_var),1)
|
||
|
kmask = [kmask;%v2($:-1:1,:)];
|
||
|
end
|
||
|
else
|
||
|
%v1 = iy_(ykmin_+1:klen,order_var)
|
||
|
kmask = cumsum(%v1($:-1:1,:),1);
|
||
|
end
|
||
|
|
||
|
kmask = kmask';
|
||
|
kmask = kmask(:);
|
||
|
i_kmask = find(kmask)';
|
||
|
// index of nonzero entries in kmask
|
||
|
nd = size(i_kmask,1);
|
||
|
// size of the state vector
|
||
|
%v = 1:nd
|
||
|
kmask(i_kmask,1) = %v(:);
|
||
|
|
||
|
// auxiliary equations
|
||
|
// elements that are both in z(t+1) and z(t)
|
||
|
k1 = find(kmask(1:length(kmask)-endo_nbr)&kmask(endo_nbr+1:length(kmask)))';
|
||
|
kad = [];
|
||
|
kae = [];
|
||
|
if ~(k1==[]) then
|
||
|
kad = kmask(k1+endo_nbr);
|
||
|
kae = kmask(k1);
|
||
|
end
|
||
|
|
||
|
// composition of state vector
|
||
|
// col 1: variable; col 2: lead/lag in z(t+1);
|
||
|
// col 3: A cols for t+1 (D); col 4: A cols for t (E)
|
||
|
|
||
|
kstate = [ones(klen-1,1).*.[1:endo_nbr]' ((klen:-1:2)').*.ones(endo_nbr,1) zeros((klen-1)*endo_nbr,2)];
|
||
|
%v = iy_(:,order_var)
|
||
|
kiy = %v($:-1:1,:)';
|
||
|
kiy = kiy(:);
|
||
|
kstate(1:ykmax_*endo_nbr,3) = kiy(1:ykmax_*endo_nbr)-endo_nbr;
|
||
|
kstate(ykmax_*endo_nbr+1:size(kstate,1),4) = kiy((ykmax_+1)*endo_nbr+1:length(kiy));
|
||
|
// put in E only the current variables that are not already in D
|
||
|
kstate = kstate(i_kmask,:);
|
||
|
dr('kstate') = kstate;
|
||
|
|
||
|
sdyn = endo_nbr-nstatic;
|
||
|
|
||
|
// buildind D and E
|
||
|
d = zeros(nd,nd);
|
||
|
e = d;
|
||
|
|
||
|
k = find((kstate(:,2)>=(ykmin_+2)) & kstate(:,3))';
|
||
|
d(1:sdyn,k) = a(nstatic+1:size(a,1),kstate(k,3));
|
||
|
k1 = find(kstate(:,2)==(ykmin_+2))';
|
||
|
|
||
|
a1 = eye(sdyn,sdyn);
|
||
|
e(1:sdyn,1:size(k1,1)) = -a1(:,kstate(k1,1)-nstatic);
|
||
|
k = find((kstate(:,2)<=(ykmin_+1))&kstate(:,4))';
|
||
|
e(1:sdyn,k) = -a(nstatic+1:size(a,1),kstate(k,4));
|
||
|
k2 = find(kstate(:,2)==(ykmin_+1))';
|
||
|
[k3,k4] = setdiff(kstate(k2,1),kstate(k1,1));
|
||
|
|
||
|
if size(k3,'*') > 0 then
|
||
|
d(1:sdyn,k2(k4)) = a1(:,k3-nstatic);
|
||
|
end
|
||
|
|
||
|
if ~(kad==[]) then
|
||
|
for j = 1:size(kad,1)
|
||
|
d(sdyn+j,kad(j)) = 1;
|
||
|
e(sdyn+j,kae(j)) = 1;
|
||
|
end
|
||
|
end
|
||
|
|
||
|
if grep(getversion(),'2.6') then
|
||
|
[ss,tt,w,sdim] = gschur(e,d,'d');
|
||
|
else
|
||
|
[ss,tt,w,sdim] = schur(e,d,'d');
|
||
|
end
|
||
|
|
||
|
nba = nd-sdim;
|
||
|
nyf = sum(kstate(:,2)>(ykmin_+1));
|
||
|
if nba~=nyf then
|
||
|
dyn_disp('LSS warning: Blanchard-Kahn conditions are not satisfied. Run CHECK to learn more!');
|
||
|
halt();
|
||
|
|
||
|
end
|
||
|
|
||
|
np = nd-nyf;
|
||
|
n2 = np+1;
|
||
|
n3 = nyf;
|
||
|
n4 = n3+1;
|
||
|
// derivatives with respect to dynamic state variables
|
||
|
// forward variables
|
||
|
gx = -w(1:n3,n2:nd)'\w(n4:nd,n2:nd)';
|
||
|
// predetermined variables
|
||
|
hx = w(1:n3,1:np)'*gx+w(n4:nd,1:np)';
|
||
|
hx = tt(1:np,1:np)*hx\(ss(1:np,1:np)*hx);
|
||
|
|
||
|
|
||
|
k1 = find(kstate(n4:nd,2) == ykmin_+1);
|
||
|
k2 = find(kstate(1:n3,2) == ykmin_+2);
|
||
|
dr('ghx') = [hx(k1,:);gx(k2(nboth+1:$),:)]
|
||
|
|
||
|
// lead variables actually present in the model
|
||
|
j3 = nonzeros(kstate(:,3));
|
||
|
j4 = find(kstate(:,3));
|
||
|
// derivatives with respect to exogenous variables
|
||
|
if exo_nbr then
|
||
|
a1 = eye(endo_nbr,endo_nbr);
|
||
|
aa1 = [];
|
||
|
if nstatic>0 then
|
||
|
aa1 = a1(:,1:nstatic);
|
||
|
end
|
||
|
dr('ghu') = -[aa1,a(:,j3)*gx(j4,1:npred+nboth)+a1(:,nstatic+1:nstatic+npred+nboth),a1(:,nstatic+npred+nboth+1:$)]\fu
|
||
|
end
|
||
|
|
||
|
// static variables
|
||
|
if nstatic>0 then
|
||
|
temp = -a(1:nstatic,j3)*gx(j4,:)*hx;
|
||
|
j5 = find(kstate(n4:nd,4));
|
||
|
temp(:,j5) = temp(:,j5)-a(1:nstatic,nonzeros(kstate(:,4)));
|
||
|
dr.ghx = [temp; dr.ghx];
|
||
|
temp = [];
|
||
|
end
|
||
|
|
||
|
dr('order_var') = order_var
|
||
|
dr('nstatic') = nstatic
|
||
|
dr('npred') = npred+nboth
|
||
|
|
||
|
if iorder==1 then
|
||
|
return
|
||
|
end
|
||
|
|
||
|
// Second order
|
||
|
tempex = ex_;
|
||
|
|
||
|
hessian = real(jacob2('ff1_',[z;exe_]));
|
||
|
|
||
|
ex_ = tempex;
|
||
|
clear('tempex');
|
||
|
|
||
|
|
||
|
np1 = sum(sum(iy_(1:ykmin_,:)>0,2));
|
||
|
zx = [eye(npred+nboth,npred+nboth);dr('ghx');gx*hx;zeros(exo_nbr,np)];
|
||
|
k1 = nonzeros(iy_(:,order_var)');
|
||
|
if exo_nbr then
|
||
|
k1 = [k1;(length(k1)+1:length(k1)+exo_nbr)'];
|
||
|
end
|
||
|
kk = matrix(1:length(k1)^2,length(k1),length(k1));
|
||
|
// reorder hessian
|
||
|
kk = kk(k1,k1);
|
||
|
hessian = hessian(:,kk);
|
||
|
rhs = -hessian*(zx.*.zx);
|
||
|
rhs = rhs(:);
|
||
|
|
||
|
//lhs
|
||
|
hxt = hx';
|
||
|
gx = dr('ghx');
|
||
|
gx = gx(size(gx,1)-nyf+1:size(gx,1),:);
|
||
|
Inp = speye(np*np,np*np);
|
||
|
|
||
|
f1 = sparse(jacobia_(:,nonzeros(iy_(ykmin_+2,:))));
|
||
|
// f_y'g_xx hx kron hx + f_y g_xx + f_y'g_x h_xx + f_x' h_xx
|
||
|
//
|
||
|
j1 = sparse(jacobia_(:,iy_(ykmin_+1,order_var)));
|
||
|
lhs = Inp.*.j1;
|
||
|
k = matrix(1:endo_nbr*np*np,endo_nbr,np*np);
|
||
|
nr = size(k,1);
|
||
|
lhs(:,k(nr-nyf+1:nr,:)) = lhs(:,k(nr-nyf+1:nr,:))+hxt.*.hxt.*.f1;
|
||
|
lhs(:,k(nstatic+1:nstatic+np,:)) = lhs(:,k(nstatic+1:nstatic+np,:))+Inp.*.(f1*gx);
|
||
|
dr('ghxx') = lhs\rhs
|
||
|
dr('ghxx') = matrix(dr('ghxx'),endo_nbr,np*np)
|
||
|
|
||
|
//ghxu
|
||
|
//rhs
|
||
|
hu = dr('ghu')(nstatic+1:nstatic+np,:);
|
||
|
zu = [zeros(np1,exo_nbr);dr('ghu');gx*hu;eye(exo_nbr,exo_nbr)];
|
||
|
nr = size(dr('ghxx'),1);
|
||
|
rhs = -hessian*(zx.*.zu)-f1*dr('ghxx')(nr-nyf+1:nr,:)*(hx.*.hu);
|
||
|
|
||
|
//lhs
|
||
|
lhs = j1;
|
||
|
lhs(:,nstatic+1:nstatic+np) = lhs(:,nstatic+1:nstatic+np)+f1*gx;
|
||
|
dr('ghxu') = lhs\rhs
|
||
|
|
||
|
//ghuu
|
||
|
//rhs
|
||
|
rhs = -hessian*(zu.*.zu)-f1*dr('ghxx')(nr-nyf+1:nr,:)*(hu.*.hu);
|
||
|
|
||
|
//lhs
|
||
|
dr('ghuu') = lhs\rhs
|
||
|
|
||
|
|
||
|
// dr.ghs2
|
||
|
// derivatives of F with respect to forward variables
|
||
|
k1 = matrix(1:size(hessian,2),size(jacobia_,2),size(jacobia_,2));
|
||
|
k1 = k1(npred+nboth+endo_nbr+1:npred+endo_nbr+2*nboth+nfwrd,npred+nboth+endo_nbr+1:npred+endo_nbr+2*nboth+nfwrd);
|
||
|
|
||
|
nr = size(dr('ghuu'),1);
|
||
|
guu = dr('ghuu')(nr-nyf+1:nr,:);
|
||
|
nr = size(dr('ghu'),1);
|
||
|
gu = dr('ghu')(nr-nyf+1:nr,:);
|
||
|
rhs = -(f1*guu+hessian(:,k1)*(gu.*.gu))*Sigma_e_(:);
|
||
|
lhs = j1;
|
||
|
lhs(:,nstatic+1:nstatic+np) = lhs(:,nstatic+1:nstatic+np)+f1*gx;
|
||
|
nc = size(lhs,2);
|
||
|
lhs(:,nc-nyf+1:nc) = lhs(:,nc-nyf+1:nc)+f1;
|
||
|
dr('ghs2') = lhs\rhs;
|
||
|
|
||
|
// 01/08/2001 MJ put return on iorder == 1 after defining dr.kstate and dr.kdyn
|
||
|
// 01/17/2001 MJ added dr.delta_s: correction factor for order = 2
|
||
|
// 01/21/2001 FC correction of delta_s for more than 1 shock
|
||
|
// 01/23/2001 MJ suppression of redundant sum() in delta_s formula
|
||
|
// 02/22/2001 MJ stderr_ replaced by Sigma_e_
|
||
|
// 08/24/2001 MJ changed the order of the variables, separates static
|
||
|
// variables and handles only one instance of variables both
|
||
|
// in lead and lag
|
||
|
// 08/24/2001 MJ added sigma to state variables as in Schmitt-Grohe and
|
||
|
// Uribe (2001)
|
||
|
// 10/30/2002 MJ corrected bugs with lags on several periods
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|