dbrent.txt

用VB实现的函数的极致和最优化 包括黄金分割搜索法、不用导数的布伦特法 用导数的布伦特法、多元函数的山单纯形法、多元函数的变尺度法等

Function DBRENT(AX, BX, CX, TOL, XMIN)
    ITMAX = 100
    ZEPS = 0.0000000001
    A = AX
    If CX < AX Then A = CX
    B = AX
    If CX > AX Then B = CX
    V = BX
    W = V
    X = V
    E = 0#
    FX = FUNC(X)
    FV1 = FX
    FW = FX
    DX = DERIV(X)
    DV = DX
    DW = DX
    For ITER = 1 To ITMAX
        XM = 0.5 * (A + B)
        TOL1 = TOL * Abs(X) + ZEPS
        TOL2 = 2# * TOL1
        If Abs(X - XM) <= (TOL2 - 0.5 * (B - A)) Then
          DONE% = -1
          Exit For
        Else
          DONE% = 0
        End If
        If Abs(E) > TOL1 Then
            D1 = 2# * (B - A)
            D2 = D1
            If DW <> DX Then D1 = (W - X) * DX / (DX - DW)
            If DV <> DX Then D2 = (V - X) * DX / (DX - DV)
            U1 = X + D1
            U2 = X + D2
            OK1 = ((A - U1) * (U1 - B) > 0#) And (DX * D1 <= 0#)
            OK2 = ((A - U2) * (U2 - B) > 0#) And (DX * D2 <= 0#)
            OLDE = E
            E = D
            If OK1 Or OK2 Then
                If OK1 And OK2 Then
                    D = D1
                Else
                    D = D2
                End If
            ElseIf OK1 Then
                D = D1
            Else
                D = D2
            End If
            If Abs(D) > Abs(0.5 * OLDE) Then
              U = X + D
              If U - A < TOL2 Or B - U < TOL2 Then D = Abs(TOL1) * Sgn(XM - X)
            End If
        End If
        If DX >= 0# Then
            E = A - X
        Else
            E = B - X
        End If
        D = 0.5 * E
          If Abs(D) >= TOL1 Then
            U = X + D
            FU = FUNC(U)
        Else
            U = X + Abs(TOL1) * Sgn(D)
            FU = FUNC(U)
            If FU > FX Then
              DONE% = -1
              Exit For
            Else
              DONE% = 0
            End If
        End If
        DU = DERIV(U)
        If FU <= FX Then
            If U >= X Then
                A = X
            Else
                B = X
            End If
            V = W
            FV1 = FW
            DV = DW
            W = X
            FW = FX
            DW = DX
            X = U
            FX = FU
            DX = DU
        Else
            If U < X Then
                A = U
            Else
                B = U
            End If
            If FU <= FW Or W = X Then
                V = W
                FV1 = FW
                DV = DW
                W = U
                FW = FU
                DW = DU
            ElseIf FU <= FV1 Or V = X Or V = W Then
                V = U
                FV1 = FU
                DV = DU
            End If
        End If
    Next ITER
    If Not DONE% Then
        Print "DBRENT exceeded maximum iterations."
    Else
        XMIN = X
        DBRENT = FX
    End If
End Function