olr2

 Copyright (C) 2003 Michel Juillard

 computes an optimal policy as the optimal linear regulator

0001 % Copyright (C) 2003 Michel Juillard
0002 %
0003 % computes an optimal policy as the optimal linear regulator
0004 %
0005 function dr=olr2(dr,olr_inst,bet,obj_var,W)
0006 
0007 global M_ options_ oo_
0008 global it_ stdexo_
0009 
0010 xlen = M_.maximum_lead + M_.maximum_lag + 1;
0011 klen = M_.maximum_lag + M_.maximum_lead + 1;
0012 iyv = M_.lead_lag_incidence';
0013 iyv = iyv(:);
0014 iyr0 = find(iyv) ;
0015 it_ = M_.maximum_lag + 1 ;
0016 
0017 inst_nbr = size(olr_inst,1);
0018 inst_i = zeros(inst_nbr,1);
0019 for i=1:inst_nbr
0020   k = strmatch(olr_inst(i,:),M_.endo_names,'exact');
0021   if isempty(k)
0022     error(sprintf('OLR_INST %s isn''t a declared variable'));
0023   else
0024     inst_i(i) = k;
0025   end
0026 end
0027 
0028 if M_.maximum_lead == 0
0029   error ('OLR : No forward variable: no point in using OLR') ;
0030 end
0031 
0032 if find(any(M_.lead_lag_incidence([1:M_.maximum_lag M_.maximum_lag+2:M_.maximum_lead],inst_i),2))
0033   error('OLR: instruments can only appear at the current period');
0034 end
0035 
0036 non_inst_i = setdiff([1:M_.endo_nbr],inst_i);
0037 iy1_ = M_.lead_lag_incidence(:,non_inst_i);
0038 endo_nbr_1 = M_.endo_nbr - inst_nbr;
0039 
0040 if M_.exo_nbr == 0
0041   oo_.exo_steady_state = [] ;
0042 end
0043 
0044 if ~ M_.lead_lag_incidence(M_.maximum_lag+1,:) > 0
0045   error ('Error in model specification: some variables don''t appear as current') ;
0046 end
0047 
0048 if xlen > 1
0049   error (['SS: stochastic exogenous variables must appear only at the' ...
0050       ' current period. Use additional endogenous variables']) ;
0051 end
0052 
0053 tempex = oo_.exo_simul;
0054 
0055 it_ = M_.maximum_lag + 1;
0056 dr.ys = oo_.steady_state; 
0057 z = repmat(dr.ys,1,klen);
0058 z = z(iyr0) ;
0059 
0060 %M_.jacobia=real(jacob_a('ff1_',[z; oo_.exo_steady_state])) ;
0061 [junk,M_.jacobia] = feval([M_.fname '_dynamic'],z,oo_.exo_simul);
0062 
0063 oo_.exo_simul = tempex ;
0064 tempex = [];
0065 
0066 nz = size(z,1);
0067 fwrd_var = find(any(M_.lead_lag_incidence(M_.maximum_lag+2:end,:),1))';
0068 if M_.maximum_lag > 0
0069   pred_var = find(any(M_.lead_lag_incidence(1:M_.maximum_lag,:),1))';
0070   both_var = intersect(pred_var,fwrd_var);
0071   pred_var = setdiff(pred_var,both_var);
0072   fwrd_var = setdiff(fwrd_var,both_var);
0073   stat_var = setdiff([1:M_.endo_nbr]',union(union(pred_var,both_var),fwrd_var));  % static variables
0074 else
0075   pred_var = [];
0076   both_var = [];
0077   stat_var = setdiff([1:M_.endo_nbr]',fwrd_var);
0078 end
0079 
0080 stat_var = setdiff(stat_var,inst_i);
0081 % static variables in objective function
0082 [stat_obj_var] = intersect(obj_var,stat_var);
0083 n_stat_obj_var = length(stat_obj_var);
0084 pred_var = [stat_obj_var; pred_var];
0085 nboth = length(both_var);
0086 npred = length(pred_var);
0087 nfwrd = length(fwrd_var);
0088 nstatic1 = length(stat_var);
0089 nstatic = nstatic1-n_stat_obj_var;
0090 
0091 order_var = [ setdiff(stat_var,obj_var); pred_var; both_var; fwrd_var];
0092 k1 = M_.lead_lag_incidence(find([1:klen] ~= M_.maximum_lag+1),:);
0093 b = M_.jacobia(1:endo_nbr_1,M_.lead_lag_incidence(M_.maximum_lag+1,order_var));
0094 a = b\M_.jacobia(1:endo_nbr_1,nonzeros(k1')); 
0095 if M_.exo_nbr
0096   fu = -b\M_.jacobia(1:endo_nbr_1,nz+1:end);
0097 end
0098 % instruments' effects
0099 b = -b\M_.jacobia(1:endo_nbr_1,M_.lead_lag_incidence(M_.maximum_lag+1,inst_i));
0100 % building kmask for z state vector in t+1
0101 if M_.maximum_lag > 0
0102   if M_.maximum_lead > 0 
0103     kmask = [flipud(cumsum(M_.lead_lag_incidence(1:M_.maximum_lag,order_var),1))] ;
0104     kmask = [kmask; flipud(cumsum(flipud(M_.lead_lag_incidence(M_.maximum_lag+2:end,order_var)),1))] ;
0105   end
0106 else
0107   kmask = flipud(cumsum(flipud(M_.lead_lag_incidence(M_.maximum_lag+2:klen,order_var)),1));
0108 end
0109 % static variables in objective function
0110 kmask(1,nstatic+1:nstatic1) = 1;
0111 kmask = kmask';
0112 
0113 % lags aren't ordered as in dr1 !
0114 % this is necessary to have the zeros on R's diagonal aligned with jump variables
0115 kmask = kmask(:);
0116 i_kmask = find(kmask);          % index of nonzero entries in kmask
0117 nd = size(i_kmask,1);           % size of the state vector
0118 kmask(i_kmask) = [1:nd];
0119 
0120 % auxiliary equations
0121 
0122 % elements that are both in z(t+1) and z(t)
0123 kad = [];
0124 kae = [];
0125 k1 = find([kmask(1:endo_nbr_1) & kmask(M_.maximum_lag*endo_nbr_1+1:(M_.maximum_lag+1)*endo_nbr_1)] );
0126 if ~isempty(k1)
0127   kad = kmask(k1);
0128   kae = kmask(k1+M_.maximum_lag*endo_nbr_1);
0129 end
0130 
0131 if M_.maximum_lag > 1
0132   k1 = find([kmask(endo_nbr_1+1:M_.maximum_lag*endo_nbr_1) & kmask(1:(M_.maximum_lag-1)*endo_nbr_1)] );
0133   if ~isempty(k1)
0134     kad = [kad; kmask(k1+endo_nbr_1)];
0135     kae = [kae; kmask(k1)];
0136   end
0137 end
0138 if M_.maximum_lead > 1
0139   k1 = find([kmask((M_.maximum_lag+1)*endo_nbr_1+1:end) & kmask(M_.maximum_lag*endo_nbr_1+1:end-endo_nbr_1)] );
0140   if ~isempty(k1)
0141     kad = [kad; kmask(M_.maximum_lag*endo_nbr_1+k1)];
0142     kae = [kae; kmask((M_.maximum_lag+1)*endo_nbr_1+k1)];
0143   end
0144 end
0145 
0146 % composition of state vector
0147 % col 1: variable;           col 2: lead/lag in z(t+1);
0148 % col 3: A cols for t+1 (D); col 4: A cols for t (E)
0149 kstate = [ repmat([1:endo_nbr_1]',klen-1,1) ...
0150        [kron([M_.maximum_lag+1:-1:2]',ones(endo_nbr_1,1)); ...
0151         kron([M_.maximum_lag+2:klen]',ones(endo_nbr_1,1))] ...
0152        zeros((klen-1)*endo_nbr_1,2)];
0153 kiy = [flipud(M_.lead_lag_incidence(1:M_.maximum_lag+1,order_var)); M_.lead_lag_incidence(M_.maximum_lag+2:end,order_var)]';
0154 kiy = kiy(:);
0155 i1 = find(kiy((M_.maximum_lag+1)*endo_nbr_1+1:end));
0156 kstate(i1+M_.maximum_lag*endo_nbr_1,3) = kiy(i1+(M_.maximum_lag+1)*endo_nbr_1)-M_.endo_nbr;  
0157 kstate(1:M_.maximum_lag*endo_nbr_1,4) = kiy(endo_nbr_1+1:(M_.maximum_lag+1)*endo_nbr_1);  
0158 % put in E only the current variables that are not already in D
0159 kstate = kstate(i_kmask,:);
0160 
0161 sdyn = M_.endo_nbr-nstatic-inst_nbr;
0162 
0163 % buildind D and E
0164 d = zeros(nd,nd) ;
0165 e = d ;
0166 
0167 % dynamical system
0168 k = find(kstate(:,2) >= M_.maximum_lag+2 & kstate(:,3));
0169 d(1:sdyn,k) = a(nstatic+1:end,kstate(k,3)) ;
0170 k1 = find(kstate(:,2) == M_.maximum_lag+2);
0171 a1 = eye(sdyn);
0172 e(1:sdyn,k1) =  -a1(:,kstate(k1,1)-nstatic);
0173 k = find(kstate(:,2) <= M_.maximum_lag+1 & kstate(:,4));
0174 e(1:sdyn,k) = -a(nstatic+1:end,kstate(k,4)) ;
0175 k2 = find(kstate(:,2) == M_.maximum_lag+1);
0176 k2 = k2(~ismember(kstate(k2,1),kstate(k1,1)));
0177 d(1:sdyn,k2) = a1(:,kstate(k2,1)-nstatic);
0178   
0179 if ~isempty(kad)
0180   for j = 1:size(kad,1)
0181     d(sdyn+j,kad(j)) = 1 ;
0182     e(sdyn+j,kae(j)) = 1 ;
0183   end
0184 end
0185 [Q,R] = qr(d);
0186 C = Q'*[e [[b(nstatic+1:end,:) fu(nstatic+1:end,:)];...
0187        zeros(nd-sdyn,inst_nbr+M_.exo_nbr)]];
0188 
0189 nyf = sum(kstate(:,2) > M_.maximum_lag+1);
0190 
0191 
0192 np = nd - nyf;
0193 
0194 
0195 dd = zeros(2*nd+inst_nbr,2*nd+inst_nbr);
0196 ee = dd;
0197 
0198 dd(1:nd,1:np) = R(:,1:np);
0199 ee(1:nd,1:np) = C(:,1:np);
0200 dd(1:nd,nd+1:nd+nyf) = R(:,np+1:end);
0201 ee(1:nd,nd+1:nd+nyf+inst_nbr) = C(:,np+1:nd+inst_nbr);
0202 
0203 
0204 % derivatives with respect to x
0205 % building QQ and UU
0206 m = 1;
0207 v0 = kstate(find(kstate(:,2)==M_.maximum_lag+2),1);
0208 for i=1:nd;
0209   if (kstate(i,2) == M_.maximum_lag+1 & isempty(find(kstate(i,1)==v0)))
0210     k = find(order_var(kstate(i,1))==obj_var);
0211     if ~isempty(k)
0212       iq(m) = i;
0213       m = m+1;
0214     end
0215   elseif kstate(i,2) == M_.maximum_lag+2
0216     k = find(order_var(kstate(i,1))==obj_var);
0217     if ~isempty(k)
0218       iq(m) = i;
0219       m = m+1;
0220     end
0221   end
0222 end
0223 QQ1 = zeros(nd,nd);
0224 QQ1(iq,iq) = W(obj_var,obj_var);
0225 UU1 = zeros(nd,inst_nbr);
0226 UU1(iq,:) = W(obj_var,inst_i);
0227 RR = W(inst_i,inst_i);
0228 offset = nd;
0229 ee(offset+1:2*offset,1:np) = bet*QQ1(1:np,:)';
0230 dd(offset+1:2*offset,np+1:nd) = bet*C(np+1:nd,1:nd)';
0231 ee(offset+1:2*offset,nd+1:nd+nyf) = bet*QQ1(np+1:end,:)';
0232 dd(offset+1:2*offset,nd+nyf+inst_nbr+1:end)=bet*C(1:np,1:nd)';
0233 ee(offset+1:2*offset,np+1:nd) = R(np+1:end,:)';
0234 ee(offset+1:2*offset,nd+nyf+1:nd+nyf+inst_nbr) = -bet*UU1;
0235 ee(offset+1:2*offset,nd+nyf+inst_nbr+1:end) = R(1:np,:)';
0236 
0237 %derivatives with respect to u
0238 offset = 2*nd;
0239 dd(offset+1:end,np+1:nd) = -C(np+1:end,nd+1:nd+inst_nbr)';
0240 dd(offset+1:end,nd+nyf+inst_nbr+1:end) = -C(1:np,nd+1:nd+inst_nbr)';
0241 ee(offset+1:end,1:np) = UU1(1:np,:)';
0242 ee(offset+1:end,nd+1:nd+nyf) = UU1(np+1:end,:)';
0243 ee(offset+1:end,nd+nyf+1:nd+nyf+inst_nbr) = RR;
0244 
0245 [ss,tt,w,sdim,oo_.eigenvalues,info] = mjdgges(ee,dd);
0246 
0247 nba = sum(abs(oo_.eigenvalues) > 1+1e-5);
0248 nyf1 = nd+inst_nbr;
0249 nd = 2*nd+inst_nbr;
0250 
0251 if nba ~= nyf1;
0252   warning('OLR: Blanchard-Kahn conditions are not satisfied.');
0253 end
0254 
0255 np1 = nd - nyf1;
0256 n2 = np1 + 1;
0257 n3 = np1;
0258 n4 = n3 + 1;
0259 
0260 % derivatives with respect to dynamic state variables
0261 % forward variables
0262 gx = -w(n4:nd,n2:nd)'\w(1:n3,n2:nd)';
0263 % predetermined variables
0264 hx = w(n4:nd,1:np1)'*gx+w(1:n3,1:np1)';
0265 hx = (tt(1:np1,1:np1)*hx)\(ss(1:np1,1:np1)*hx);
0266 
0267 % including Lagrange multipliers in M_.endo_names, order_var and kstate
0268 for i=1:M_.maximum_lead
0269   k = find(kstate(:,2)==M_.maximum_lag+1+i);
0270   temp = strcat('mult_',M_.endo_names(order_var(kstate(k,1)),:));
0271   temp = strcat(temp,['_' int2str(i)]);
0272   M_.endo_names = strvcat(M_.endo_names,temp);
0273 end
0274 
0275 if nyf > nboth    
0276   order_var = [order_var(1:nstatic+npred+nboth);[M_.endo_nbr+1:M_.endo_nbr+nyf]'; ...
0277           order_var(nstatic+npred+nboth+1:end); inst_i];
0278 else
0279   order_var = [order_var(1:nstatic+npred+nboth);[M_.endo_nbr+1:M_.endo_nbr+nyf]'; ...
0280           inst_i];
0281 end
0282 kstate = [kstate(1:np,:);zeros(nyf,4);kstate(np+1:end,:);zeros(inst_nbr+np,4)];
0283 k = find(kstate(:,2) <= M_.maximum_lag+1);
0284 kstate(np+1:np+nyf,1:2) = [[nstatic+npred+nboth+1:nstatic+npred+nboth+nyf]' ...
0285             (M_.maximum_lag+1)*ones(nyf,1)];
0286 kstate(np+2*nyf+1:np+2*nyf+inst_nbr,1:2) = [[endo_nbr_1+1:endo_nbr_1+inst_nbr]' ...
0287             (M_.maximum_lag+2)*ones(inst_nbr,1)];
0288 kstate(np+2*nyf+inst_nbr+1:end,1:2) = [[M_.endo_nbr+1:M_.endo_nbr+np]' (M_.maximum_lag+2)*ones(np,1)];
0289 
0290 k1 = find(kstate(:,2) == M_.maximum_lag+1);
0291 k2 = find(kstate(:,2) == M_.maximum_lag+2)-np-nyf;
0292 dr.ghx = [hx(k1,:); gx(k2(nboth+1:end),:)];
0293 
0294 %lead variables actually present in the model
0295 % derivatives with respect to exogenous variables
0296 if M_.exo_nbr
0297   n1 = find(kstate(:,2) > M_.maximum_lag+1);
0298   ghu = [dd(:,n1(1):end)*gx+dd(:,1:n1(1)-1) -ee(:,np+nyf+1:end)]\[C(:,end-M_.exo_nbr+1:end); zeros(size(dd,1)-size(C,1),M_.exo_nbr)];
0299   dr.ghu = [ghu(k1,:);ghu(k2(nboth+1:end)+np+nyf,:)];
0300 end
0301 
0302 % static variables
0303 if nstatic > 0
0304   j3 = nonzeros(kstate(:,3));
0305   j4  = find(kstate(:,3))-np-nyf;
0306   temp = -a(1:nstatic,j3)*gx(j4,:)*hx;
0307   temp = temp + b(1:nstatic,:)*gx(nyf+1:nyf+inst_nbr,:);
0308   j5 = find(kstate(:,4));
0309   temp(:,j5) = temp(:,j5)-a(1:nstatic,nonzeros(kstate(:,4)));
0310   dr.ghx = [temp; dr.ghx];
0311   temp = -a(1:nstatic,j3)*gx(j4,:)*ghu(1:np+nyf,:);
0312   temp = temp + b(1:nstatic,:)*ghu(np+2*nyf+1:np+2*nyf+inst_nbr,:);
0313   temp = temp + fu(1:nstatic,:);
0314   dr.ghu = [temp; dr.ghu]; 
0315   temp = [];
0316 end
0317 
0318 dr.ghx = dr.ghx(1:M_.endo_nbr+nyf,:);
0319 dr.ghu = dr.ghu(1:M_.endo_nbr+nyf,:);
0320 
0321 dr.ys = [dr.ys; zeros(nyf,1)];
0322 dr.nstatic1 = nstatic1;
0323 dr.nstatic = nstatic;
0324 dr.npred = npred+nyf+nboth;
0325 dr.kstate = kstate;
0326 dr.order_var = order_var;
0327 M_.endo_nbr = M_.endo_nbr+nyf;
0328 
0329 % 05/29/03 MJ replaced diffext by jacobia (much faster)
0330 %             corrected kmask for static variables in objective function
0331 
0332 
0333 
0334