simplx.txt

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

Sub SIMPLX(A(), M, N, MP, NP, M1, M2, M3, ICASE, IZROV(), IPOSV())
    EPS = 0.000001
    Dim L1(100), L2(100), L3(100)
    If M <> M1 + M2 + M3 Then
        Print " Bad input constraint counts"
        Exit Sub
    End If
    NL1 = N
    For K = 1 To N
        L1(K) = K
        IZROV(K) = K
    Next K
    NL2 = M
    For I = 1 To M
        If A(I + 1, 1) < 0# Then
            Print " Bad input tableau."
            Exit Sub
        End If
        L2(I) = I
        IPOSV(I) = N + I
    Next I
    For I = 1 To M2
        L3(I) = 1
    Next I
    IR = 0
    If M2 + M3 = 0 Then GoTo 3
    IR = 1
    For K = 1 To N + 1
        Q1 = 0#
        For I = M1 + 1 To M
            Q1 = Q1 + A(I + 1, K)
        Next I
        A(M + 2, K) = -Q1
    Next K
    Do
        Call SIMP1(A(), MP, NP, M + 1, L1(), NL1, 0, KP, BMAX)
        If BMAX <= EPS And A(M + 2, 1) < -EPS Then
          ICASE = -1
          Erase L3, L2, L1
          Exit Sub
        ElseIf BMAX <= EPS And A(M + 2, 1) <= EPS Then
          M12 = M1 + M2 + 1
          If M12 <= M Then
              For IP = M12 To M
                  If IPOSV(IP) = IP + N Then
                      Call SIMP1(A(), MP, NP, IP, L1(), NL1, 1, KP, BMAX)
                      If BMAX > 0# Then GoTo 1
                  End If
              Next IP
          End If
          IR = 0
          M12 = M12 - 1
          If M1 + 1 > M12 Then Exit Do
          For I = M1 + 1 To M12
              If L3(I - M1) = 1 Then
                  For K = 1 To N + 1
                      A(I + 1, K) = -A(I + 1, K)
                  Next K
              End If
          Next I
          Exit Do
        End If
        Call SIMP2(A(), M, N, MP, NP, L2(), NL2, IP, KP, Q1)
        If IP = 0 Then
          ICASE = -1
          Erase L3, L2, L1
          Exit Sub
        End If
1       Call SIMP3(A(), MP, NP, M + 1, N, IP, KP)
        If IPOSV(IP) >= N + M1 + M2 + 1 Then
          For K = 1 To NL1
              If L1(K) = KP Then Exit For
          Next K
          NL1 = NL1 - 1
          For IQ = K To NL1
              L1(IQ) = L1(IQ + 1)
          Next IQ
        Else
          If IPOSV(IP) < N + M1 + 1 Then GoTo 2
          KH = IPOSV(IP) - M1 - N
          If L3(KH) = 0 Then GoTo 2
          L3(KH) = 0
        End If
        A(M + 2, KP + 1) = A(M + 2, KP + 1) + 1#
        For I = 1 To M + 2
          A(I, KP + 1) = -A(I, KP + 1)
        Next I
2       IQ = IZROV(KP)
        IZROV(KP) = IPOSV(IP)
        IPOSV(IP) = IQ
    Loop While IR <> 0
3   Call SIMP1(A(), MP, NP, 0, L1(), NL1, 0, KP, BMAX)
    If BMAX <= 0# Then
        ICASE = 0
        Erase L3, L2, L1
        Exit Sub
    End If
    Call SIMP2(A(), M, N, MP, NP, L2(), NL2, IP, KP, Q1)
    If IP = 0 Then
        ICASE = 1
        Erase L3, L2, L1
        Exit Sub
    End If
    Call SIMP3(A(), MP, NP, M, N, IP, KP)
    GoTo 2
End Sub