mr_gstep

 Copyright (C) 2005 Marco Ratto

 function [f0, x] = mr_gstep(func0,x,htol0,varargin)
 
 Gibbs type step in optimisation

0001 function [f0, x] = mr_gstep(func0,x,htol0,varargin)
0002 % Copyright (C) 2005 Marco Ratto
0003 %
0004 % function [f0, x] = mr_gstep(func0,x,htol0,varargin)
0005 %
0006 % Gibbs type step in optimisation
0007 
0008 global bayestopt_ options_
0009 persistent h1 
0010 
0011 gstep_ = options_.gstep;
0012 if nargin<3, 
0013     htol = 1.e-6;
0014 else
0015     htol = htol0;
0016 end
0017 func = str2func(func0);
0018 f0=feval(func,x,varargin{:});
0019 n=size(x,1);
0020 h2=bayestopt_.ub-bayestopt_.lb;
0021 
0022 if isempty(h1),
0023     h1=max(abs(x),sqrt(gstep_)*ones(n,1))*eps^(1/4);
0024 end
0025 
0026 xh1=x;
0027 f1=zeros(size(f0,1),n);
0028 f_1=f1;
0029 %for i=1:n,
0030 i=0;
0031 while i<n,
0032     i=i+1;
0033     h10=h1(i);
0034     hcheck=0;
0035     dx=[];
0036     xh1(i)=x(i)+h1(i);
0037     fx = feval(func,xh1,varargin{:});
0038     it=1;
0039     dx=(fx-f0);
0040     ic=0;
0041 %     if abs(dx)>(2*htol),
0042 %         c=mr_nlincon(xh1,varargin{:});
0043 %         while c
0044 %             h1(i)=h1(i)*0.9;
0045 %             xh1(i)=x(i)+h1(i);
0046 %             c=mr_nlincon(xh1,varargin{:});
0047 %             ic=1;
0048 %         end
0049 %         if ic,
0050 %             fx = feval(func,xh1,varargin{:});
0051 %             dx=(fx-f0);
0052 %         end
0053 %     end
0054     
0055     icount = 0;
0056     h0=h1(i);
0057     while (abs(dx(it))<0.5*htol | abs(dx(it))>(2*htol)) & icount<10 & ic==0,
0058         %while abs(dx(it))<0.5*htol & icount< 10 & ic==0,
0059         icount=icount+1;
0060         if abs(dx(it)) ~= 0,
0061             if abs(dx(it))<0.5*htol
0062                 h1(i)=min(0.3*abs(x(i)), 0.9*htol/abs(dx(it))*h1(i));
0063                 xh1(i)=x(i)+h1(i);
0064 %                 c=mr_nlincon(xh1,varargin{:});
0065 %                 while c
0066 %                     h1(i)=h1(i)*0.9;
0067 %                     xh1(i)=x(i)+h1(i);
0068 %                     c=mr_nlincon(xh1,varargin{:});
0069 %                     ic=1;
0070 %                 end
0071             end
0072             if abs(dx(it))>(2*htol),
0073                 h1(i)= htol/abs(dx(it))*h1(i);
0074                 xh1(i)=x(i)+h1(i);
0075             end
0076             fx = feval(func,xh1,varargin{:});
0077             it=it+1;
0078             dx(it)=(fx-f0);
0079             h0(it)=h1(i);
0080             if h1(i)<1.e-12*min(1,h2(i)),
0081                 ic=1;
0082                 hcheck=1;
0083             end
0084         else
0085             h1(i)=1;
0086             ic=1;
0087         end
0088     end
0089     f1(:,i)=fx;
0090     xh1(i)=x(i)-h1(i);
0091 %     c=mr_nlincon(xh1,varargin{:});
0092 %    ic=0;
0093 %     while c
0094 %         h1(i)=h1(i)*0.9;
0095 %         xh1(i)=x(i)-h1(i);
0096 %         c=mr_nlincon(xh1,varargin{:});
0097 %         ic = 1;
0098 %     end
0099     fx = feval(func,xh1,varargin{:});
0100     f_1(:,i)=fx;
0101 %     if ic,
0102 %         xh1(i)=x(i)+h1(i);
0103 %         f1(:,i)=feval(func,xh1,varargin{:});
0104 %     end
0105     if hcheck & htol<1,
0106         htol=min(1,max(min(abs(dx))*2,htol*10));
0107         h1(i)=h10;
0108         xh1(i)=x(i);
0109         i=i-1;
0110     else
0111         gg=zeros(size(x));    
0112         hh=gg;
0113         gg(i)=(f1(i)'-f_1(i)')./(2.*h1(i));
0114         if abs(f1(i)+f_1(i)-2*f0)>1.e-12,
0115             hh(i) = abs(1/( (f1(i)+f_1(i)-2*f0)./(h1(i)*h1(i)) ));
0116         else
0117             hh(i) = 1;
0118         end
0119             
0120         if gg(i)*(hh(i)*gg(i))/2 > htol,
0121             [f0 x fc retcode] = csminit(func0,x,f0,gg,0,diag(hh),varargin{:});
0122         end
0123         xh1=x;
0124     end
0125     save gstep
0126 end
0127 
0128 save gstep
0129 
0130 
0131