stab_map_

 function x0 = stab_map_(Nsam, fload, alpha2, prepSA, pprior)

 Mapping of stability regions in the prior ranges applying
 Monte Carlo filtering techniques.

 M. Ratto, Global Sensitivity Analysis for Macroeconomic models
 I. Mapping stability, MIMEO, 2005.

 INPUTS
 Nsam = MC sample size
 fload = 0 to run new MC; 1 to load prevoiusly generated analysis
 alpha2 =  significance level for bivariate sensitivity analysis
 [abs(corrcoef) > alpha2]
 prepSA = 1: save transition matrices for mapping reduced form
        = 0: no transition matrix saved (default)
 pprior = 1: sample from prior ranges (default): sample saved in
            _prior.mat   file
        = 0: sample from posterior ranges: sample saved in
            _mc.mat file
 OUTPUT: 
 x0: one parameter vector for which the model is stable.

 GRAPHS
 1) Pdf's of marginal distributions under the stability (dotted
     lines) and unstability (solid lines) regions
 2) Cumulative distributions of: 
   - stable subset (dotted lines) 
   - unacceptable subset (solid lines)
 3) Bivariate plots of significant correlation patterns 
  ( abs(corrcoef) > alpha2) under the stable and unacceptable subsets

 USES lptauSEQ, 
      stab_map_1, stab_map_2

 Copyright (C) 2005 Marco Ratto
 THIS PROGRAM WAS WRITTEN FOR MATLAB BY
 Marco Ratto,
 Unit of Econometrics and Statistics AF
 (http://www.jrc.cec.eu.int/uasa/),
 IPSC, Joint Research Centre
 The European Commission,
 TP 361, 21020 ISPRA(VA), ITALY
 marco.ratto@jrc.it 

 ALL COPIES MUST BE PROVIDED FREE OF CHARGE AND MUST INCLUDE THIS COPYRIGHT
 NOTICE.

0001 function x0 = stab_map_(Nsam, fload, ksstat, alpha2, prepSA, pprior, ilptau, OutputDirectoryName)
0002 %
0003 % function x0 = stab_map_(Nsam, fload, alpha2, prepSA, pprior)
0004 %
0005 % Mapping of stability regions in the prior ranges applying
0006 % Monte Carlo filtering techniques.
0007 %
0008 % M. Ratto, Global Sensitivity Analysis for Macroeconomic models
0009 % I. Mapping stability, MIMEO, 2005.
0010 %
0011 % INPUTS
0012 % Nsam = MC sample size
0013 % fload = 0 to run new MC; 1 to load prevoiusly generated analysis
0014 % alpha2 =  significance level for bivariate sensitivity analysis
0015 % [abs(corrcoef) > alpha2]
0016 % prepSA = 1: save transition matrices for mapping reduced form
0017 %        = 0: no transition matrix saved (default)
0018 % pprior = 1: sample from prior ranges (default): sample saved in
0019 %            _prior.mat   file
0020 %        = 0: sample from posterior ranges: sample saved in
0021 %            _mc.mat file
0022 % OUTPUT:
0023 % x0: one parameter vector for which the model is stable.
0024 %
0025 % GRAPHS
0026 % 1) Pdf's of marginal distributions under the stability (dotted
0027 %     lines) and unstability (solid lines) regions
0028 % 2) Cumulative distributions of:
0029 %   - stable subset (dotted lines)
0030 %   - unacceptable subset (solid lines)
0031 % 3) Bivariate plots of significant correlation patterns
0032 %  ( abs(corrcoef) > alpha2) under the stable and unacceptable subsets
0033 %
0034 % USES lptauSEQ,
0035 %      stab_map_1, stab_map_2
0036 %
0037 % Copyright (C) 2005 Marco Ratto
0038 % THIS PROGRAM WAS WRITTEN FOR MATLAB BY
0039 % Marco Ratto,
0040 % Unit of Econometrics and Statistics AF
0041 % (http://www.jrc.cec.eu.int/uasa/),
0042 % IPSC, Joint Research Centre
0043 % The European Commission,
0044 % TP 361, 21020 ISPRA(VA), ITALY
0045 % marco.ratto@jrc.it
0046 %
0047 % ALL COPIES MUST BE PROVIDED FREE OF CHARGE AND MUST INCLUDE THIS COPYRIGHT
0048 % NOTICE.
0049 %
0050 
0051 %global bayestopt_ estim_params_ dr_ options_ ys_ fname_
0052 global bayestopt_ estim_params_ options_ oo_ M_
0053 
0054 dr_ = oo_.dr;
0055 if isfield(dr_,'ghx'),
0056   ys_ = oo_.dr.ys;
0057   nspred = size(dr_.ghx,2);
0058   nboth = dr_.nboth;
0059   nfwrd = dr_.nfwrd;
0060 end
0061 fname_ = M_.fname;
0062 
0063 nshock = estim_params_.nvx;
0064 nshock = nshock + estim_params_.nvn;
0065 nshock = nshock + estim_params_.ncx;
0066 nshock = nshock + estim_params_.ncn;
0067 
0068 
0069 if nargin==0,
0070   Nsam=2000; %2^13; %256;
0071 end
0072 if nargin<2,
0073   fload=0;
0074 end
0075 if nargin<3,
0076   ksstat=0.1;
0077 end
0078 if nargin<4,
0079   alpha2=0.3;
0080 end
0081 if nargin<5,
0082   prepSA=0;
0083 end
0084 if nargin<6,
0085   pprior=1;
0086 end
0087 if nargin<7,
0088   ilptau=1;
0089 end
0090 if nargin<8,
0091   OutputDirectoryName='';
0092 end
0093 
0094 options_.periods=0;
0095 options_.nomoments=1;
0096 options_.irf=0;
0097 options_.noprint=1;
0098 
0099 if fload==0 | nargin<2 | isempty(fload),
0100   if prepSA
0101     T=zeros(size(dr_.ghx,1),size(dr_.ghx,2)+size(dr_.ghu,2),Nsam/2);
0102   end
0103   
0104   
0105   if estim_params_.np<52 & ilptau,
0106     [lpmat] = lptauSEQ(Nsam,estim_params_.np);
0107     if estim_params_.np>30
0108       for j=1:estim_params_.np,
0109         lpmat(:,j)=lpmat(randperm(Nsam),j);
0110       end
0111     end
0112   else
0113     %[lpmat] = rand(Nsam,estim_params_.np);
0114     for j=1:estim_params_.np,
0115       lpmat(:,j) = randperm(Nsam)'./(Nsam+1); %latin hypercube
0116     end
0117   end
0118   
0119   if pprior,
0120     for j=1:nshock,
0121       lpmat0(:,j) = randperm(Nsam)'./(Nsam+1); %latin hypercube
0122       lpmat0(:,j)=lpmat0(:,j).*(bayestopt_.ub(j)-bayestopt_.lb(j))+bayestopt_.lb(j);
0123     end
0124     for j=1:estim_params_.np,
0125       lpmat(:,j)=lpmat(:,j).*(bayestopt_.ub(j+nshock)-bayestopt_.lb(j+nshock))+bayestopt_.lb(j+nshock);
0126     end
0127   else
0128     %         for j=1:nshock,
0129     %             xparam1(j) = oo_.posterior_mode.shocks_std.(bayestopt_.name{j});
0130     %             sd(j) = oo_.posterior_std.shocks_std.(bayestopt_.name{j});
0131     %             lpmat0(:,j) = randperm(Nsam)'./(Nsam+1); %latin hypercube
0132     %             lb = max(bayestopt_.lb(j), xparam1(j)-2*sd(j));
0133     %             ub1=xparam1(j)+(xparam1(j) - lb); % define symmetric range around the mode!
0134     %             ub = min(bayestopt_.ub(j),ub1);
0135     %             if ub<ub1,
0136     %                 lb=xparam1(j)-(ub-xparam1(j)); % define symmetric range around the mode!
0137     %             end
0138     %             lpmat0(:,j) = lpmat0(:,j).*(ub-lb)+lb;
0139     %         end
0140     %         %
0141     %         for j=1:estim_params_.np,
0142     %             xparam1(j+nshock) = oo_.posterior_mode.parameters.(bayestopt_.name{j+nshock});
0143     %             sd(j+nshock) = oo_.posterior_std.parameters.(bayestopt_.name{j+nshock});
0144     %             lb = max(bayestopt_.lb(j+nshock),xparam1(j+nshock)-2*sd(j+nshock));
0145     %             ub1=xparam1(j+nshock)+(xparam1(j+nshock) - lb); % define symmetric range around the mode!
0146     %             ub = min(bayestopt_.ub(j+nshock),ub1);
0147     %             if ub<ub1,
0148     %                 lb=xparam1(j+nshock)-(ub-xparam1(j+nshock)); % define symmetric range around the mode!
0149     %             end
0150     %             %ub = min(bayestopt_.ub(j+nshock),xparam1(j+nshock)+2*sd(j+nshock));
0151     %             if estim_params_.np>30 & estim_params_.np<52
0152     %                 lpmat(:,j) = lpmat(randperm(Nsam),j).*(ub-lb)+lb;
0153     %             else
0154     %                 lpmat(:,j) = lpmat(:,j).*(ub-lb)+lb;
0155     %             end
0156     %         end
0157     %load([fname_,'_mode'])
0158     eval(['load ' options_.mode_file ';']');
0159     d = chol(inv(hh));
0160     lp=randn(Nsam*2,nshock+estim_params_.np)*d+kron(ones(Nsam*2,1),xparam1');
0161     for j=1:Nsam*2,
0162         lnprior(j) = any(lp(j,:)'<=bayestopt_.lb | lp(j,:)'>=bayestopt_.ub);
0163     end
0164     ireal=[1:2*Nsam]; 
0165     ireal=ireal(find(lnprior==0));
0166     lp=lp(ireal,:);
0167     Nsam=min(Nsam, length(ireal));
0168     lpmat0=lp(1:Nsam,1:nshock);
0169     lpmat=lp(1:Nsam,nshock+1:end);
0170     clear lp lnprior ireal;
0171   end
0172   %
0173   h = waitbar(0,'Please wait...');
0174   istable=[1:Nsam];
0175   jstab=0;
0176   iunstable=[1:Nsam];
0177   iindeterm=zeros(1,Nsam);
0178   iwrong=zeros(1,Nsam);
0179   for j=1:Nsam,
0180     M_.params(estim_params_.param_vals(:,1)) = lpmat(j,:)';
0181     stoch_simul([]);
0182     dr_ = oo_.dr;
0183     if isfield(dr_,'ghx'),
0184       egg(:,j) = sort(dr_.eigval);
0185       iunstable(j)=0;
0186       if prepSA
0187         jstab=jstab+1;
0188         T(:,:,jstab) = [dr_.ghx dr_.ghu];
0189       end            
0190       if ~exist('nspred'),
0191         nspred = size(dr_.ghx,2);
0192         nboth = dr_.nboth;
0193         nfwrd = dr_.nfwrd;
0194       end
0195     else
0196       istable(j)=0;
0197       if isfield(dr_,'eigval')
0198         egg(:,j) = sort(dr_.eigval);
0199         if any(isnan(egg(1:nspred,j)))
0200           iwrong(j)=j;
0201         else
0202           if (nboth | nfwrd) & abs(egg(nspred+1,j))<=options_.qz_criterium,
0203             iindeterm(j)=j;
0204           end                                      
0205         end  
0206       else
0207         egg(:,j)=ones(size(egg,1),1).*1.1;
0208         iwrong(j)=j;
0209       end
0210     end
0211     ys_=real(dr_.ys);
0212     yys(:,j) = ys_;
0213     ys_=yys(:,1);
0214     waitbar(j/Nsam,h,['MC iteration ',int2str(j),'/',int2str(Nsam)])
0215   end
0216   close(h)
0217   if prepSA,
0218     T=T(:,:,1:jstab);
0219   end
0220   istable=istable(find(istable));  % stable params
0221   iunstable=iunstable(find(iunstable));   % unstable params
0222   iindeterm=iindeterm(find(iindeterm));  % indeterminacy
0223   iwrong=iwrong(find(iwrong));  % dynare could not find solution
0224   
0225   %     % map stable samples
0226   %     istable=[1:Nsam];
0227   %     for j=1:Nsam,
0228   %         if any(isnan(egg(1:nspred,j)))
0229   %             istable(j)=0;
0230   %         else
0231   %             if abs(egg(nspred,j))>=options_.qz_criterium; %(1-(options_.qz_criterium-1)); %1-1.e-5;
0232   %                 istable(j)=0;
0233   %                 %elseif (dr_.nboth | dr_.nfwrd) & abs(egg(nspred+1,j))<=options_.qz_criterium; %1+1.e-5;
0234   %             elseif (nboth | nfwrd) & abs(egg(nspred+1,j))<=options_.qz_criterium; %1+1.e-5;
0235   %                 istable(j)=0;
0236   %             end
0237   %         end
0238   %     end
0239   %     istable=istable(find(istable));  % stable params
0240   %
0241   %     % map unstable samples
0242   %     iunstable=[1:Nsam];
0243   %     for j=1:Nsam,
0244   %         %if abs(egg(dr_.npred+1,j))>1+1.e-5 & abs(egg(dr_.npred,j))<1-1.e-5;
0245   %         %if (dr_.nboth | dr_.nfwrd),
0246   %         if ~any(isnan(egg(1:5,j)))
0247   %             if (nboth | nfwrd),
0248   %                 if abs(egg(nspred+1,j))>options_.qz_criterium & abs(egg(nspred,j))<options_.qz_criterium; %(1-(options_.qz_criterium-1));
0249   %                     iunstable(j)=0;
0250   %                 end
0251   %             else
0252   %                 if abs(egg(nspred,j))<options_.qz_criterium; %(1-(options_.qz_criterium-1));
0253   %                     iunstable(j)=0;
0254   %                 end
0255   %             end
0256   %         end
0257   %     end
0258   %     iunstable=iunstable(find(iunstable));   % unstable params
0259   if pprior,
0260     if ~prepSA
0261       save([OutputDirectoryName '\' fname_ '_prior'],'lpmat','lpmat0','iunstable','istable','iindeterm','iwrong','egg','yys','nspred','nboth','nfwrd')
0262     else
0263       save([OutputDirectoryName '\' fname_ '_prior'],'lpmat','lpmat0','iunstable','istable','iindeterm','iwrong','egg','yys','T','nspred','nboth','nfwrd')
0264     end
0265     
0266   else
0267     if ~prepSA
0268       save([OutputDirectoryName '\' fname_ '_mc'], ...
0269         'lpmat','lpmat0','iunstable','istable','iindeterm','iwrong','egg','yys','nspred','nboth','nfwrd')
0270     else
0271       save([OutputDirectoryName '\' fname_ '_mc'], ...
0272         'lpmat','lpmat0','iunstable','istable','iindeterm','iwrong','egg','yys','T','nspred','nboth','nfwrd')
0273     end
0274   end
0275 else
0276   if pprior,
0277     filetoload=[OutputDirectoryName '\' fname_ '_prior'];
0278   else
0279     filetoload=[OutputDirectoryName '\' fname_ '_mc'];
0280   end
0281   load(filetoload,'lpmat','lpmat0','iunstable','istable','iindeterm','iwrong','egg','yys','nspred','nboth','nfwrd')
0282   Nsam = size(lpmat,1);    
0283   
0284   if prepSA & isempty(strmatch('T',who('-file', filetoload),'exact')),
0285     h = waitbar(0,'Please wait...');
0286     options_.periods=0;
0287     options_.nomoments=1;
0288     options_.irf=0;
0289     options_.noprint=1;
0290     stoch_simul([]);
0291     T=zeros(size(dr_.ghx,1),size(dr_.ghx,2)+size(dr_.ghu,2),length(istable));
0292     ntrans=length(istable);
0293     for j=1:ntrans,
0294       M_.params(estim_params_.param_vals(:,1)) = lpmat(istable(j),:)';
0295       stoch_simul([]);
0296       dr_ = oo_.dr;
0297       T(:,:,j) = [dr_.ghx dr_.ghu];
0298       if ~exist('nspred')
0299         nspred = size(dr_.ghx,2);
0300         nboth = dr_.nboth;
0301         nfwrd = dr_.nfwrd;
0302       end
0303       ys_=real(dr_.ys);
0304       yys(:,j) = ys_;
0305       ys_=yys(:,1);
0306       waitbar(j/ntrans,h,['MC iteration ',int2str(j),'/',int2str(ntrans)])
0307     end
0308     close(h)
0309     save(filetoload,'T','-append')    
0310   end
0311 end
0312 
0313 if pprior
0314   aname='prior_stab';
0315   auname='prior_unacceptable';
0316   aunstname='prior_unstable';
0317   aindname='prior_indeterm';
0318   asname='prior_stable';
0319 else
0320   aname='mc_stab';
0321   auname='mc_unacceptable';
0322   aunstname='mc_unstable';
0323   aindname='mc_indeterm';
0324   asname='mc_stable';
0325 end
0326 delete([OutputDirectoryName,'\',fname_,'_',aname,'_*.*']);
0327 %delete([OutputDirectoryName,'\',fname_,'_',aname,'_SA_*.*']);
0328 delete([OutputDirectoryName,'\',fname_,'_',asname,'_corr_*.*']);
0329 delete([OutputDirectoryName,'\',fname_,'_',auname,'_corr_*.*']);
0330 delete([OutputDirectoryName,'\',fname_,'_',aunstname,'_corr_*.*']);
0331 delete([OutputDirectoryName,'\',fname_,'_',aindname,'_corr_*.*']);
0332 
0333 if length(iunstable)>0 & length(iunstable)<Nsam,
0334   disp([num2str(length(istable)/Nsam*100),'\% of the prior support is stable.'])
0335   disp([num2str( (length(iunstable)-length(iwrong)-length(iindeterm) )/Nsam*100),'\% of the prior support is unstable.'])
0336   if ~isempty(iindeterm),
0337     disp([num2str(length(iindeterm)/Nsam*100),'\% of the prior support gives indeterminacy.'])
0338   end
0339   if ~isempty(iwrong),
0340     disp(' ');
0341     disp(['For ',num2str(length(iwrong)/Nsam*100),'\% of the prior support dynare could not find a solution.'])      
0342   end
0343   % Blanchard Kahn
0344   [proba, dproba] = stab_map_1(lpmat, istable, iunstable, aname,0);
0345   indstab=find(dproba>ksstat);
0346   disp('The following parameters mostly drive acceptable behaviour')
0347   disp(M_.param_names(estim_params_.param_vals(indstab,1),:))  
0348   stab_map_1(lpmat, istable, iunstable, aname, 1, indstab, OutputDirectoryName);
0349   if ~isempty(iindeterm),
0350     ixun=iunstable(find(~ismember(iunstable,[iindeterm,iwrong])));
0351     [proba, dproba] = stab_map_1(lpmat, [1:Nsam], iindeterm, [aname, '_indet'],0);
0352     indindet=find(dproba>ksstat);
0353     disp('The following parameters mostly drive indeterminacy')
0354     disp(M_.param_names(estim_params_.param_vals(indindet,1),:))  
0355     stab_map_1(lpmat, [1:Nsam], iindeterm, [aname, '_indet'], 1, indindet, OutputDirectoryName);
0356     if ~isempty(ixun),
0357       [proba, dproba] = stab_map_1(lpmat, [1:Nsam], ixun, [aname, '_unst'],0);
0358       indunst=find(dproba>ksstat);
0359       disp('The following parameters mostly drive instability')
0360       disp(M_.param_names(estim_params_.param_vals(indunst,1),:))  
0361       stab_map_1(lpmat, [1:Nsam], ixun, [aname, '_unst'], 1, indunst, OutputDirectoryName);
0362     end
0363   end
0364   
0365   disp(' ')
0366   disp('Starting bivariate analysis:')
0367   
0368   c0=corrcoef(lpmat(istable,:));
0369   c00=tril(c0,-1);
0370   
0371   stab_map_2(lpmat(istable,:),alpha2, asname, OutputDirectoryName);
0372   stab_map_2(lpmat(iunstable,:),alpha2, auname, OutputDirectoryName);
0373   if ~isempty(iindeterm),
0374     stab_map_2(lpmat(iindeterm,:),alpha2, aindname, OutputDirectoryName);
0375     if ~isempty(ixun),
0376       stab_map_2(lpmat(ixun,:),alpha2, aunstname, OutputDirectoryName);
0377     end
0378   end
0379   
0380   x0=0.5.*(bayestopt_.ub(1:nshock)-bayestopt_.lb(1:nshock))+bayestopt_.lb(1:nshock);
0381   x0 = [x0; lpmat(istable(1),:)'];
0382   if istable(end)~=Nsam
0383     M_.params(estim_params_.param_vals(:,1)) = lpmat(istable(1),:)';
0384     stoch_simul([]);        
0385   end
0386 else
0387   if length(iunstable)==0,
0388     disp('All parameter values in the specified ranges are stable!')
0389     x0=0.5.*(bayestopt_.ub(1:nshock)-bayestopt_.lb(1:nshock))+bayestopt_.lb(1:nshock);
0390     x0 = [x0; lpmat(istable(1),:)'];
0391   else
0392     disp('All parameter values in the specified ranges are not acceptable!')        
0393     x0=[];
0394   end
0395   
0396 end