csminit

 [fhat,xhat,fcount,retcode] = csminit(fcn,x0,f0,g0,badg,H0,...
                                       P1,P2,P3,P4,P5,P6,P7,P8)
 retcodes: 0, normal step.  5, largest step still improves too fast.
 4,2 back and forth adjustment of stepsize didn't finish.  3, smallest
 stepsize still improves too slow.  6, no improvement found.  1, zero
 gradient.
---------------------
 Modified 7/22/96 to omit variable-length P list, for efficiency and compilation.
 Places where the number of P's need to be altered or the code could be returned to
 its old form are marked with ARGLIST comments.

 Fixed 7/17/93 to use inverse-hessian instead of hessian itself in bfgs
 update.

 Fixed 7/19/93 to flip eigenvalues of H to get better performance when
 it's not psd.

tailstr = ')';
for i=nargin-6:-1:1
   tailstr=[ ',P' num2str(i)  tailstr];
end
ANGLE = .03;

0001 function [fhat,xhat,fcount,retcode] = csminit(fcn,x0,f0,g0,badg,H0,varargin)
0002 % [fhat,xhat,fcount,retcode] = csminit(fcn,x0,f0,g0,badg,H0,...
0003 %                                       P1,P2,P3,P4,P5,P6,P7,P8)
0004 % retcodes: 0, normal step.  5, largest step still improves too fast.
0005 % 4,2 back and forth adjustment of stepsize didn't finish.  3, smallest
0006 % stepsize still improves too slow.  6, no improvement found.  1, zero
0007 % gradient.
0008 %---------------------
0009 % Modified 7/22/96 to omit variable-length P list, for efficiency and compilation.
0010 % Places where the number of P's need to be altered or the code could be returned to
0011 % its old form are marked with ARGLIST comments.
0012 %
0013 % Fixed 7/17/93 to use inverse-hessian instead of hessian itself in bfgs
0014 % update.
0015 %
0016 % Fixed 7/19/93 to flip eigenvalues of H to get better performance when
0017 % it's not psd.
0018 %
0019 %tailstr = ')';
0020 %for i=nargin-6:-1:1
0021 %   tailstr=[ ',P' num2str(i)  tailstr];
0022 %end
0023 %ANGLE = .03;
0024 ANGLE = .005;
0025 %THETA = .03;
0026 THETA = .3; %(0<THETA<.5) THETA near .5 makes long line searches, possibly fewer iterations.
0027 FCHANGE = 1000;
0028 MINLAMB = 1e-9;
0029 % fixed 7/15/94
0030 % MINDX = .0001;
0031 % MINDX = 1e-6;
0032 MINDFAC = .01;
0033 fcount=0;
0034 lambda=1;
0035 xhat=x0;
0036 f=f0;
0037 fhat=f0;
0038 g = g0;
0039 gnorm = norm(g);
0040 %
0041 if (gnorm < 1.e-12) & ~badg % put ~badg 8/4/94
0042    retcode =1;
0043    dxnorm=0;
0044    % gradient convergence
0045 else
0046    % with badg true, we don't try to match rate of improvement to directional
0047    % derivative.  We're satisfied just to get some improvement in f.
0048    %
0049    %if(badg)
0050    %   dx = -g*FCHANGE/(gnorm*gnorm);
0051    %  dxnorm = norm(dx);
0052    %  if dxnorm > 1e12
0053    %     disp('Bad, small gradient problem.')
0054    %     dx = dx*FCHANGE/dxnorm;
0055    %   end
0056    %else
0057    % Gauss-Newton step;
0058    %---------- Start of 7/19/93 mod ---------------
0059    %[v d] = eig(H0);
0060    %toc
0061    %d=max(1e-10,abs(diag(d)));
0062    %d=abs(diag(d));
0063    %dx = -(v.*(ones(size(v,1),1)*d'))*(v'*g);
0064 %      toc
0065    dx = -H0*g;
0066 %      toc
0067    dxnorm = norm(dx);
0068    if dxnorm > 1e12
0069       disp('Near-singular H problem.')
0070       dx = dx*FCHANGE/dxnorm;
0071    end
0072    dfhat = dx'*g0;
0073    %end
0074    %
0075    %
0076    if ~badg
0077       % test for alignment of dx with gradient and fix if necessary
0078       a = -dfhat/(gnorm*dxnorm);
0079       if a<ANGLE
0080          dx = dx - (ANGLE*dxnorm/gnorm+dfhat/(gnorm*gnorm))*g;
0081          dfhat = dx'*g;
0082          dxnorm = norm(dx);
0083          disp(sprintf('Correct for low angle: %g',a))
0084       end
0085    end
0086    disp(sprintf('Predicted improvement: %18.9f',-dfhat/2))
0087    %
0088    % Have OK dx, now adjust length of step (lambda) until min and
0089    % max improvement rate criteria are met.
0090    done=0;
0091    factor=3;
0092    shrink=1;
0093    lambdaMin=0;
0094    lambdaMax=inf;
0095    lambdaPeak=0;
0096    fPeak=f0;
0097    lambdahat=0;
0098    while ~done
0099       if size(x0,2)>1
0100          dxtest=x0+dx'*lambda;
0101       else
0102          dxtest=x0+dx*lambda;
0103       end
0104       % home
0105       f = eval([fcn '(dxtest,varargin{:})']);
0106       %ARGLIST
0107       %f = feval(fcn,dxtest,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13);
0108       % f = feval(fcn,x0+dx*lambda,P1,P2,P3,P4,P5,P6,P7,P8);
0109       disp(sprintf('lambda = %10.5g; f = %20.7f',lambda,f ))
0110       %debug
0111       %disp(sprintf('Improvement too great? f0-f: %g, criterion: %g',f0-f,-(1-THETA)*dfhat*lambda))
0112       if f<fhat
0113          fhat=f;
0114          xhat=dxtest;
0115          lambdahat = lambda;
0116       end
0117       fcount=fcount+1;
0118       shrinkSignal = (~badg & (f0-f < max([-THETA*dfhat*lambda 0]))) | (badg & (f0-f) < 0) ;
0119       growSignal = ~badg & ( (lambda > 0)  &  (f0-f > -(1-THETA)*dfhat*lambda) );
0120       if  shrinkSignal  &   ( (lambda>lambdaPeak) | (lambda<0) )
0121          if (lambda>0) & ((~shrink) | (lambda/factor <= lambdaPeak))
0122             shrink=1;
0123             factor=factor^.6;
0124             while lambda/factor <= lambdaPeak
0125                factor=factor^.6;
0126             end
0127             %if (abs(lambda)*(factor-1)*dxnorm < MINDX) | (abs(lambda)*(factor-1) < MINLAMB)
0128             if abs(factor-1)<MINDFAC
0129                if abs(lambda)<4
0130                   retcode=2;
0131                else
0132                   retcode=7;
0133                end
0134                done=1;
0135             end
0136          end
0137          if (lambda<lambdaMax) & (lambda>lambdaPeak)
0138             lambdaMax=lambda;
0139          end
0140          lambda=lambda/factor;
0141          if abs(lambda) < MINLAMB
0142             if (lambda > 0) & (f0 <= fhat)
0143                % try going against gradient, which may be inaccurate
0144                lambda = -lambda*factor^6
0145             else
0146                if lambda < 0
0147                   retcode = 6;
0148                else
0149                   retcode = 3;
0150                end
0151                done = 1;
0152             end
0153          end
0154       elseif  (growSignal & lambda>0) |  (shrinkSignal & ((lambda <= lambdaPeak) & (lambda>0)))
0155          if shrink
0156             shrink=0;
0157             factor = factor^.6;
0158             %if ( abs(lambda)*(factor-1)*dxnorm< MINDX ) | ( abs(lambda)*(factor-1)< MINLAMB)
0159             if abs(factor-1)<MINDFAC
0160                if abs(lambda)<4
0161                   retcode=4;
0162                else
0163                   retcode=7;
0164                end
0165                done=1;
0166             end
0167          end
0168          if ( f<fPeak ) & (lambda>0)
0169             fPeak=f;
0170             lambdaPeak=lambda;
0171             if lambdaMax<=lambdaPeak
0172                lambdaMax=lambdaPeak*factor*factor;
0173             end
0174          end
0175          lambda=lambda*factor;
0176          if abs(lambda) > 1e20;
0177             retcode = 5;
0178             done =1;
0179          end
0180       else
0181          done=1;
0182          if factor < 1.2
0183             retcode=7;
0184          else
0185             retcode=0;
0186          end
0187       end
0188    end
0189 end
0190 disp(sprintf('Norm of dx %10.5g', dxnorm))