/* ********************************************************************* */
/* ONE PARAMETER SMART GRID SEARCH ROUTINE  - By C. Rookley                    */
/* syntax: {xpar,maxval}=
          sgrid1(startx,endx,xnint,niters,&fnname) 
          
&fnname must be a user defined function which is given externally
        and accepting one input, and providing a single return

where: xpar is the argument which maximizes the function given
       by &fnname
       maxval is the value of the function at its maximum
       startx,        - starting point for the intial grid search
       endx           - ending point for the initial grid search
       xnint          - number of intervals to search over 
       niters         - number of iterations  

Globals: _gridout   Controls printing of grid search to the screen.
                    if _gridout=0 (default) no iterative information
                    will be printed. 
         
         _gridlb    Lower bound for grid search.  Search assumes
                    values to the left of this value are implausible
                    and hence will not venture into this area.  If 
                    _gridlb=-99 (default) no lower bound will be imposed.

         _gridub    Same as _gridlb but for the upper bound.
                    _gridub=-99 (default)

         _smflag    Useful if Obj. function is assumed to be monotone
                    in choice variable being searched over.  _smflag=1
                    stops the current iteration once the function starts
                    to decrease. (Default=0)

Description of procedure:  sgrid1 will do an inital search over the
                           parameter x, starting with startx and 
                           go in equal increments until
                           xend is reached.  If the optimal parameter
                           value occurs at an lower (upper) bound, it
                           will continue the initial search in a new interval 
                           to the left (right) of the original lower bound.
                           If iter>1, it will then proceed to do a finer
                           search around the last maximized value.
                           The process will continue until final iter. is
                           reached.
******************************************************************* */

/* SOURCE CODE: */

proc(2)=sgrid1(startx,endx,xnint,niters,&fnname); 
local iter,xinc,gridmat,rowptr,maxx,valmax;
local xval,lrsf,lref,gap;
local fnname:proc;
local nls,nrs;
local lastval;
#include sgrid1.dec;
nls=0; nrs=0;
lrsf=0; lref=0;
iter=1;
do while iter le niters;
   xinc=(endx-startx)/xnint;
   gridmat=-(10^200).*ones(xnint+10,1);
   xval=startx;
   lastval=-(10^200);
   rowptr=1;
   do while xval le endx+(xinc/2);
        gridmat[rowptr]=fnname(xval);
        if _gridout ne 0;
          print xval~gridmat[rowptr];
        endif;
        if (gridmat[rowptr]-lastval)<0 and _smflag==1; /* brk-out if
                                        fn gets worse and smooth flag=1 */
           xval=endx;
        else;
           lastval=gridmat[rowptr];
           rowptr=rowptr+1;
        endif;
        xval=xval+xinc;
   endo;
   valmax=maxc(gridmat);
   if maxindc(gridmat)==1 and gridmat[1]==gridmat[2];
      maxx=endx;
   else;
      maxx=startx+(maxindc(gridmat)-1)*xinc;
   endif;
   gap=endx-startx;
   if feq(maxx,endx) and lrsf==0 and fne(maxx,_gridub);
      nrs=nrs+1;
      if _gridub ne -99; 
        if endx+gap < _gridub;
           startx=endx;
           endx=endx+gap;
        else;
           startx=endx;
           endx=_gridub;
        endif;
      else; 
        startx=endx;
        endx=endx+gap;
      endif;
      lref=1; /* last run max on end flag */
      lrsf=0;
   elseif feq(maxx,startx) and lref==0 and fne(maxx,_gridlb);
     nls=nls+1;
     if _gridlb ne -99; 
        if startx-(gap) > _gridlb;
           endx=startx;
           startx=startx-gap;
        else;
           endx=startx;
           startx=_gridlb;
        endif;
     else;  
        endx=startx;
        startx=startx-gap;
     endif;
     lrsf=1; /* last run max on start flag */
     lref=0;
   elseif feq(maxx,_gridub) and _gridub ne -99;
     startx=_gridub-xinc;
     endx=_gridub;
   elseif feq(maxx,_gridlb) and _gridlb ne -99;
     startx=_gridlb;
     endx=_gridlb+xinc;
   else;
      lref=0; lrsf=0;
      startx=maxx-xinc;
      endx=maxx+xinc;
      nrs=0; nls=0;
      iter=iter+1;
   endif;
   if nrs>300 or nls>300;
      print "gridsearch failed";
      retp(-99,-99);
   endif;
endo;
retp(maxx,valmax);
endp;



