dfpmin.txt

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

Sub DFPMIN(P(), N, FTOL, ITER, FRET)
    ITMAX = 200
    EPS = 0.0000000001
    Dim HESSIN(50, 50), XI(50), G(50), DG(50), HDG(50)
    FP = FUNC2(P(), N)
    Call DFUNC(P(), G())
    For I = 1 To N
        For J = 1 To N
            HESSIN(I, J) = 0#
        Next J
        HESSIN(I, I) = 1#
        XI(I) = -G(I)
    Next I
    For ITS = 1 To ITMAX
        ITER = ITS
        Call LINMIN(P(), XI(), N, FRET)
        If 2# * Abs(FRET - FP) <= FTOL * (Abs(FRET) + Abs(FP) + EPS) Then
            Erase HDG, DG, G, XI, HESSIN
            Exit Sub
        End If
        FP = FRET
        For I = 1 To N
            DG(I) = G(I)
        Next I
        FRET = FUNC2(P(), N)
        Call DFUNC(P(), G())
        For I = 1 To N
            DG(I) = G(I) - DG(I)
        Next I
        For I = 1 To N
            HDG(I) = 0#
            For J = 1 To N
                HDG(I) = HDG(I) + HESSIN(I, J) * DG(J)
            Next J
        Next I
        FAC = 0#
        FAE = 0#
        For I = 1 To N
            FAC = FAC + DG(I) * XI(I)
            FAE = FAE + DG(I) * HDG(I)
        Next I
        FAC = 1# / FAC
        FAD = 1# / FAE
        For I = 1 To N
            DG(I) = FAC * XI(I) - FAD * HDG(I)
        Next I
        For I = 1 To N
            For J = 1 To N
              AAA = FAC * XI(I) * XI(J) - FAD * HDG(I) * HDG(J)
              BBB = FAE * DG(I) * DG(J)
              HESSIN(I, J) = HESSIN(I, J) + AAA + BBB
            Next J
        Next I
        For I = 1 To N
            XI(I) = 0#
            For J = 1 To N
                XI(I) = XI(I) - HESSIN(I, J) * G(J)
            Next J
        Next I
    Next ITS
    If ITS > ITMAX Then Print " too many iterations in DFPMIN"
    Erase HDG, DG, G, XI, HESSIN
End Sub