'******************************************************** '* Find minimum of a real function Y=F(X) * '* using routine for Golden Section Search * '* ---------------------------------------------------- * '* REFERENCE: "Numerical Recipes, The Art of Scientific * '* Computing By W.H. Press, B.P. Flannery, * '* S.A. Teukolsky and W.T. Vetterling, * '* Cambridge University Press, 1986" [8]. * '* ---------------------------------------------------- * '* Sample run: * '* * '* Find a minimum of function X*SIN(X)-2*COS(X) * '* between X=4 and X=6. * '* * '* X1=4.d0 X2=5.d0 X3=6.d0 TOL=1.d-6 * '* * '* Function minimum is: -5.53452877400217 * '* * '* for X= 5.232937106616176 * '* * '* BASIC Version By J-P Moreau. * '* (www.jpmoreau.fr) * '******************************************************** Defdbl a-h,o-z AX=4# : BX=5# : CX=6# TOL=1e-6 gosub 2000 'call Golden subroutine cls print print " Function minimum is "; YMINI print print " for X="; XMINI print END 'Function to be analyzed 1000 F=xx*SIN(xx)-2*COS(xx) RETURN 'FUNCTION GOLDEN(AX,BX,CX,TOL,XMIN) 'Given a function F, and given a bracketing triplet of abscissas 'AX, BX, CX (such that BX is between AX and CX, and F(BX) is less 'than both F(AX) and F(CX)), this routine performs a golden section 'search for the minimum, isolating it to a fractional precision of 'about TOL. The abscissa of the minimum is returned as XMIN, and the minimum 'function value is returned as GOLDEN, the returned function value. 2000 R=.61803399 : C=1-R 'Golden ratios X0=AX 'At any given time we will keep trace of 4 points: X3=CX 'X0,X1,X2,X3. IF ABS(CX-BX) > ABS(BX-AX) THEN X1=BX : X2=BX+C*(CX-BX) ELSE X2=BX : X1=BX-C*(BX-AX) END IF 'Initial function evaluations xx=X1:gosub 1000:F1=F xx=X2:gosub 1000:F2=F 1 IF ABS(X3-X0) > TOL*(ABS(X1)+ABS(X2)) THEN IF F2 < F1 THEN X0=X1 : X1=X2 X2=R*X1+C*X3 F0=F1 : F1=F2 xx=X2:gosub 1000:F2=F ELSE X3=X2 : X2=X1 X1=R*X2+C*X0 F3=F2 : F2=F1 xx=X1:gosub 1000:F1=F END IF GOTO 1 END IF IF F1 < F2 THEN YMINI=F1 XMINI=X1 ELSE YMINI=F2 XMINI=X2 END IF RETURN 'end of file golden.bas