True BASIC Program to Find a Function Minimum

Using the Broyden-Fletcher-Goldfarb-Shanno (BFGS) Method

by Namir Shammas

The following program uses the Broyden-Fletcher-Goldfarb-Shanno (BFGS) method to find the minimum of a function. This method is a quasi-Newton method. That is, the BFGS method is based on Newton's method but performs different calculations to update the guess refinements.

The program prompts you to enter for each variable (i.e. dimension):

1. The maximum number of iterations.

2. The tolerance for the minimized function,

3. The tolerance for the gradient.

4. The initial guesses for the optimum point for each variable.

5. The tolerance for the guess refinement for each variable.

The program displays intermediate values for the function and the variables. The program displays the following final results:

1. The coordinates of the minimum point.

2. The minimum function value.

3. The number of iterations

The current code finds the minimum for the following function:

f(x1,x2) = x1 - x2 + 2 * x1 ^ 2 + 2 * x1 * x2 + x2 ^ 2

Here is a sample session to solve for the optimum of the above function:

Here is the BASIC listing: 

! Broyden-Fletcher-Goldfarb-Shanno Method (BFGS)

OPTION TYPO
OPTION NOLET

DECLARE NUMERIC MAX_VARS, N, I, EPSF, EPSG, T1, T2, F
DECLARE NUMERIC fNorm, Lambda, Iter, MaxIter
DECLARE NUMERIC bStop, bTrue, bFalse, boolRes

Dim X(1), Toler(1)
Dim grad1(1,1), grad2(1,1), g(1,1), d(1,1), S(1,1)
Dim Bmat(1,1), Mmat(1,1), Nmat(1,1)
Dim MM1(1,1), MM2(1,1), MM3(1,1), MM4(1,1)
Dim MM5(1,1), MM6(1,1), MM7(1,1), MM8(1,1)
Dim MM9(1,1), MM10(1,1), MM11(1,1)

bTrue = 1
bFalse = 0


SUB CalcNorm(X(,), N, FNorm)
  LOCAL I

  FNorm = 0
  For I = 1 To N
    FNorm = FNorm + X(I,1)^2
  Next I
  FNorm = Sqr(FNorm)

END SUB

SUB MyFx(X(), N, Res)
  ! Res = 100 * (X(1) ^ 2 - X(2)) ^ 2 + (1 - X(1)) ^ 2
  Res = X(1) - X(2) + 2 * X(1) ^ 2 + 2 * X(1) * X(2) + X(2) ^ 2
End SUB

SUB FirstDeriv(N, X(), iVar, funRes)
  LOCAL Xt, h, Fp, Fm

  Xt = X(iVar)
  h = 0.01 * (1 + Abs(Xt))
  X(iVar) = Xt + h
  CALL MyFx(X, N, Fp)
  X(iVar) = Xt - h
  CALL MyFx(X, N, Fm)
  X(iVar) = Xt
  funRes = (Fp - Fm) / 2 / h
End SUB

Sub GetFirstDerives(N, X(), FirstDerivX(,))

  LOCAL I

  For I = 1 To N
    CALL FirstDeriv(N, X, I, FirstDerivX(I,1))
  Next I
End Sub

SUB MyFxEx(N, X(), DeltaX(,), Lambda, funRes)
  LOCAL I, XX(1)

  MAT REDIM XX(N)

  For I = 1 To N
    XX(I) = X(I) + Lambda * DeltaX(I,1)
  Next I

  CALL MyFx(XX, N, funRes)
End SUB

SUB LinSearch_DirectSearch(X(), N, Lambda, DeltaX(,), InitStep, MinStep, boolRes)
  LOCAL F1, F2

  CALL MyFxEx(N, X, DeltaX, Lambda, F1)

  Do
    CALL MyFxEx(N, X, DeltaX, Lambda + InitStep, F2)
    If F2 < F1 Then
      F1 = F2
      Lambda = Lambda + InitStep
    Else
      CALL MyFxEx(N, X, DeltaX, Lambda - InitStep, F2)
      If F2 < F1 Then
        F1 = F2
        Lambda = Lambda - InitStep
      Else
        ! reduce search step size
        InitStep = InitStep / 10
      End If
    End If
  Loop Until InitStep < MinStep

  boolRes = bTrue

End SUB

! Broyden-Fletcher-Goldfarb-Shanno Method (BFGS)

MAX_VARS = 2


MAT REDIM Toler(MAX_VARS)
MAT REDIM X(MAX_VARS)
MAT REDIM grad1(MAX_VARS,1)
MAT REDIM grad2(MAX_VARS,1)
MAT REDIM g(MAX_VARS,1)
MAT REDIM d(MAX_VARS,1)
MAT REDIM S(MAX_VARS,1)
MAT REDIM Bmat(MAX_VARS, MAX_VARS)
MAT REDIM Mmat(MAX_VARS, MAX_VARS)
MAT REDIM Nmat(MAX_VARS, MAX_VARS)
MAT REDIM MM1(MAX_VARS, MAX_VARS)
MAT REDIM MM2(MAX_VARS, MAX_VARS)
MAT REDIM MM3(MAX_VARS, MAX_VARS)
MAT REDIM MM4(MAX_VARS, MAX_VARS)
MAT REDIM MM5(MAX_VARS, MAX_VARS)
MAT REDIM MM6(MAX_VARS, MAX_VARS)
MAT REDIM MM7(MAX_VARS, MAX_VARS)
MAT REDIM MM8(MAX_VARS, MAX_VARS)
MAT REDIM MM9(MAX_VARS, MAX_VARS)
MAT REDIM MM10(MAX_VARS, MAX_VARS)
MAT REDIM MM11(MAX_VARS, MAX_VARS)


N = MAX_VARS

PRINT "Broyden-Fletcher-Goldfarb-Shanno Method (BFGS)"
INPUT PROMPT "Enter maximum number of iterations? ": MaxIter
INPUT PROMPT "Enter function tolerance? ": EPSF
INPUT PROMPT "Enter gradient tolerance? ": EPSG
N = MAX_VARS
For I = 1 To N
  PRINT "Enter value for X(";I;")";
  INPUT X(I)
  PRINT "Enter tolerance value for X(";I;")";
  INPUT Toler(I)
Next I

! set matrix B as an indentity matrix
MAT Bmat = IDN(MAX_VARS)

Iter = 0
! calculate initial gradient
CALL GetFirstDerives(N, X, grad1)

! start main loop
Do

  Iter = Iter + 1
  If Iter > MaxIter Then
    PRINT "Reached iteration limits"
    Exit Do
  End If

  ! calcuate vector S() and reverse its sign
  MAT S = Bmat * grad1
  MAT S = (-1) * S

  ! test if gradient is shallow enough
  CALL CalcNorm(S, N, fNorm)
  MAT S = (1/fNorm) * S ! objML.NormalizeVect S

  Lambda = 0.1
  CALL LinSearch_DirectSearch(X, N, Lambda, S, 0.1, 0.00001, boolRes)
  ! calculate optimum X()
  MAT d = (Lambda) * S
  For I = 1 To N
    X(I) = X(I) + d(I,1)
  Next I

  ! get new gradient
  CALL GetFirstDerives(N, X, grad2)
  MAT g = grad2 - grad1
  MAT grad1 = grad2

  ! test for convergence
  bStop = bTrue
  For I = 1 To N
    If Abs(d(I,1)) > Toler(I) Then
      bStop = bFalse
      Exit For
    End If
  Next I

  If bStop = bTrue Then
    PRINT "Exit due to values of Lambda * S()"
    PRINT "Lamda="; Lambda
    PRINT "Array S is:"
    For I = 1 To N
      PRINT "S(";I;")=";S(I,1);" ";
    Next I
    PRINT
    Exit Do
  End If

  ! exit if gradient is low
  CALL CalcNorm(g, N, fNorm)
  If fNorm < EPSG Then
    PRINT "Exit due to G Norm"
    PRINT "Norm=";fNorm
    Exit Do
  End If

  !-------------------------------------------------
  ! Start elaborate process to upgare matrix B
  !
  ! MM1 = g as column matrix
  MAT MM1 = g
  ! MM2 = d as column matrix
  MAT MM2 = d
  ! MM3 = g^T
  MAT MM3 = TRN(g)
  ! MM4 = d^T
  MAT MM4 = TRN(d)
  ! MM5 = d d^T
  MAT MM5 = MM2 * MM4
  ! MM6 = d^T g
  MAT MM6 = MM4 * MM1
  ! MM7 = d g^T
  MAT MM7 = MM2 * MM3
  ! MM8 = g d^T
  MAT MM8 = MM1 * MM4
  !objML.MatMultMat MM3, Bmat, MM9
  MAT MM9 = MM3 * Bmat
  ! MM9 = g^T [B] g
  MAT MM9 = MM1 * MM9
  ! MM10 = d g^T [B]
  MAT MM10 = MM7 * Bmat
  ! MM11 = [B] g d^T
  MAT MM11 = Bmat * MM8

  T1 = MM6(1, 1) ! d^T g
  T2 = (1 + MM9(1, 1) / T1) / T1
  MAT MM5 = (T2) * MM5
  MAT MM10 = (1/T1) * MM10
  MAT MM11 = (1/T2) * MM11
  MAT Bmat = Bmat + MM5
  MAT Bmat = Bmat - MM10
  MAT Bmat = Bmat - MM11

  CALL MyFx(X, N, F)
  PRINT "F = ";F;" ";
  For I = 1 To N
    PRINT "X(";I;")=";X(I);" ";
    PRINT "g(";I;")=";g(I,1);" ";
  Next I
  PRINT

Loop

PRINT "********FINAL RESULTS**********"
For I = 1 To N
  PRINT "X(";I;")=";X(I)
Next I
For I = 1 To N
  PRINT "Gradient(";I;")=";g(I,1)
Next I
CALL MyFx(X, N, F)
PRINT "Function value = ";F
PRINT "Iterations = ";Iter

END

BACK

Copyright (c) Namir Shammas. All rights reserved.