线性规划代码__vb.txt

线性规划算法

Dim W, M, G, E, N, Z
N = W + G
Z = 0
Dim A()
ReDim A(M + 2, N + M + 3)
For i = 1 To M + 2
    For j = 1 To N + M + 3
       A(i, j) = 0
    Next
Next

  For i = 1 To M + 2
    A(i, 1) = N + i - 1
    A(i, 2) = XL(i, W + 1)
    A(i, N + M + 3) = XL(i, W + 2)
    For j = 1 To W
       A(i, j + 2) = XL(i, j)
    Next
  Next

  A(1, 1) = 0

Dim YSYS(), X(100)
ReDim YSYS(M, 1)
'  &&营养素
' REDIME X(N+M)

For i = 1 To N + M
     X(i) = 0
Next


OJ = 1
For i = 2 To M + 1
    A(i, 2 + N + i - 1) = 1
    If A(i, 2) = 2 Or A(i, 2) = 0 Then
         If A(i, 2) = 2 Then
            A(i, 2 + W + OJ) = -1
            OJ = OJ + 1
         End If
        A(i, 2) = -999
    End If
Next

  For i = 2 To M + 1
       If A(i, 2) > 0 Then
          A(i, 2) = 0
       End If
  Next

For i = 1 To W
      A(1, 2 + i) = -1 * A(1, 2 + i)
Next

Dim ODAD()
ReDim ODAD(M)
'*************************************
For i = 1 To M
    ODAD(i) = A(i + 1, 2)
Next

For i = 2 + N + 1 To 2 + N + M
     A(1, i) = ODAD(i - (2 + N))
Next
'*************************************************************


For i = 2 + N + 1 To 2 + N + M
     If A(1, i) = -999 Then
        A(1, i) = -100000000000000#
     End If
Next
For i = 2 To M + 1
     If A(i, 2) = -999 Then
       A(i, 2) = -100000000000000#
     End If
Next

Dim XXX, S, L1, M9, NN, P, K
XXX = 1
Dim O()
ReDim O(M)
For i = 1 To M
     O(i) = A(i + 1, M + N + 3)
Next
A(M + 2, 1) = 0
A(M + 2, 2) = 0
For j = 3 To M + N + 3
     S = 0
     For i = 2 To M + 1
        S = S + A(i, 2) * A(i, j)
     Next
     A(M + 2, j) = A(1, j) - S
Next
A(M + 2, M + N + 3) = -A(M + 2, M + N + 3)
T = 0

'*     WAIT WINDOW NOWAIT '迭代次数：' + STR(T,3)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Do While True

     M9 = 0
     For j = 3 To M + N + 2
         If A(M + 2, j) > M9 Then
            M9 = A(M + 2, j)
           K = j
         End If
     Next
     
      
        If T >= 200 Then
             Exit Do
        End If
        If T <> 0 Then
            If M9 <= 0.00000001 Then
               Exit Do
            End If
        End If
        If M9 <= 0 Then
           MsgBox "无最优解,请重新修改配方模型和约束条件...."
          '  MsgBOX '无最优解a feasible solution does not exist'
        End If


     ' DIM C()
      ReDim C(M + 1)
      L1 = 100000000000000#
      For i = 2 To M + 1
          If A(i, K) > 0.000000001 Then
             C(i) = A(i, M + N + 3) / A(i, K)
             If C(i) < L1 Then
                L1 = C(i)
                P = i
             End If
          End If
      Next
      
       If L1 = 100000000000000# Then
          MsgBox "无最优解,请重新修改配方模型和约束条件...."
         '   'objective function is not bound by constraints'
       End If
        H = A(P, K)
        For j = 3 To M + N + 3
            A(P, j) = A(P, j) / H
        Next
      
        For i = 2 To M + 1
            If Not i = P Then
                H = A(i, K)
                If Not H = 0 Then
                   For j = 3 To M + N + 3
                      A(i, j) = A(i, j) - A(P, j) * H
                   Next
                End If
            End If
        Next
         A(P, 1) = K - 2
         A(P, 2) = A(1, K)
         For j = 3 To M + N + 3
             S = 0
             For i = 2 To M + 1
                 S = S + A(i, 2) * A(i, j)
             Next
             A(M + 2, j) = A(1, j) - S
          Next
          
          A(M + 2, M + N + 3) = -A(M + 2, M + N + 3)
          T = T + 1
Loop


' DIM B( M + N + 2 )
ReDim B(M + N + 2)
...........

For i = 2 To M + 1
     X(A(i, 1)) = A(i, M + N + 3)
     If A(i, 2) = -100000000000000# Then
        Exit For
     End If
Next

For j = 1 To M + N
     For i = 2 To M + 1
        If j = A(i, 1) Then
           Exit For
        End If
     Next
      If j <> A(i, 1) Then
         X(j) = 0
      End If
Next
If XXX = 0 Then
     Z = A(M + 2, M + N + 3)
Else
     Z = -A(M + 2, M + N + 3)
End If

Dim OPR()
ReDim OPR(M, 2)
For j = N + 3 To M + N + 2
     If A(1, j) = 0 Then
        OPR(j - N - 2, 1) = -A(M + 2, j)
     Else
        OPR(j - N - 2, 1) = A(M + 2, j) - A(1, j)
     End If
Next
Dim D(100), EEE(100)
' IF M > W THEN
'    REDIM D(M) , EEE(M)
' ELSE
'    REDIM D(W) , EEE(W)
' END IF
For j = N + 3 To M + N + 2
     L1 = 100000000000000#
     For i = 2 To M + 1
         If A(i, j) > 0 Then
........................
         End If
      Next
      D(j - N - 2) = L1
      L1 = 100000000000000#
      For i = 2 To M + 1
          If -A(i, j) > 0 Then
              C(i) = -A(i, M + N + 3) / A(i, j)
              If C(i) < L1 Then
                 L1 = C(i)
              End If
          End If
       Next
       EEE(j - N - 2) = L1
Next
''''''''''''''''''''''''''''

'''''''''''''''''''''''''''
For i = 1 To M
        If D(i) = 100000000000000# Then
            OPR(i, 2) = " 0.0000 - " + CStr(FormatNumber((O(i) + EEE(i)) / 100, 4, -1, 0, 0))
        Else
           If EEE(i) = 100000000000000# Then
             '   OPR( I , 2 ) = CSTR((O(I) - D(I)) / 100) + " - 无限大"
                OPR(i, 2) = CStr(FormatNumber((O(i) - D(i)) / 100, 4, -1, 0, 0)) + " - 无限大"
           Else
                OPR(i, 2) = CStr(FormatNumber((O(i) - D(i)) / 100, 4, -1, 0, 0)) + " - " + CStr(FormatNumber((O(i) + EEE(i)) / 100, 4, -1, 0, 0))
           End If
        End If
Next

Dim SRNG()
ReDim SRNG(W)
For j = 1 To W
     SRNG(j) = " "
     D(j) = 100000000000000#
     EEE(j) = -100000000000000#
     If B(j) = 0 Then
        D(j) = Abs(A(1, j + 2)) + A(M + 2, j + 2)
        If D(j) < 0 Then
           D(j) = 0
        End If
      Else
         For i = 2 To M + 1
            If A(i, 1) = j Then
               K = i
            End If
         Next
         For i = 3 To N + M + 2
             If A(M + 2, i) <> 0 Then
                If A(K, i) < 0 Then
                    L1 = A(M + 2, i) / A(K, i)

                    If D(j) > L1 Then
                       D(j) = L1
                    End If
                End If
                If A(K, i) > 0 Then
                    L1 = A(M + 2, i) / A(K, i)
                  '  E( J ) = MAX(EEE(J),L1)
                    If EEE(j) < L1 Then
                       EEE(j) = L1
                    End If
                End If
             End If
         Next
         If D(j) = 100000000000000# Then
             D(j) = 0
         Else
             D(j) = Abs(A(1, j + 2)) - Abs(D(j))
         End If
         If EEE(j) = -100000000000000# Then
             EEE(j) = Abs(EEE(j))
          Else
             EEE(j) = Abs(A(1, j + 2)) + Abs(EEE(j))
          End If
          If D(j) < 0 Then
            D(j) = 0
          End If
       End If
Next