单纯刑法.frm

完整的数值模拟软件

VERSION 5.00
Begin VB.Form Form21 
   BackColor       =   &H00FFFFFF&
   Caption         =   "单纯形法"
   ClientHeight    =   7830
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7875
   LinkTopic       =   "Form13"
   ScaleHeight     =   7830
   ScaleWidth      =   7875
   StartUpPosition =   3  '窗口缺省
End
Attribute VB_Name = "Form21"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim f0!
Dim n As Integer, m As Integer
Dim a(), b(), x(), c()
Private Sub dcxbxs(a(), b(), c())
Print Tab(6); String(12 * (n + 2), "_")

i = 1
Do While i <= n
    Print Tab(12 * i); "x(" & i & ")";
    i = i + 1
Loop
Print Spc(8); "-f"; Spc(8); "  b  "
Print Tab(6); String(12 * (n + 2), "_")
i = 1
Do While i <= m
    j = 1
    Print
    Do While j <= n
        Print Tab(12 * j); Format(a(i, j), "#######.##");
        j = j + 1
    Loop
    Print Tab(12 * j); "0";
    Print Tab(12 * (j + 1)); Format(b(i), "#######.####");
    i = i + 1
Loop
Print Tab(6); String(12 * (n + 2), "_")

j = 1
Print
Do While j <= n
   Print Tab(12 * j); Format(c(j), "#######.##");
   j = j + 1
Loop
Print Tab(12 * j); "1";
Print Tab(12 * (j + 1)); Format(f0, "#######.####");
Print Tab(6); String(12 * (n + 2), "_")

End Sub

Private Sub Form_Click()
n = InputBox("输入变量的个数")
m = InputBox("输入方程的个数")
'n = 4
'm = 2
ReDim a(m, n), b(m), x(n), c(n)

'a(1, 1) = 1: a(1, 2) = -1: a(1, 3) = 1: a(1, 4) = 0: b(1) = 1
'a(2, 1) = 3: a(2, 2) = -2: a(2, 3) = 0: a(2, 4) = 1: b(2) = 6
'c(1) = -3: c(2) = -2: c(3) = 0: c(4) = 0






k = 0

i = 1
Do While i <= m
j = 1
Do While j <= n
a(i, j) = Val(InputBox("a(" & i & "," & j & ")=  "))
j = j + 1
Loop
b(i) = Val(InputBox("b(" & i & ")=  "))
i = i + 1
Loop
j = 1
Do While j <= n
c(j) = Val(InputBox("c(" & j & ")=  "))
j = j + 1
Loop




f0 = 0
Print
Print
Print
Print "                  k=" & k & "时的单纯形表："
Call dcxbxs(a(), b(), c())

MsgBox "按任意键继续"

Do While True
   '找出最小的Cs
   s = 1
   cs = c(1)
   i = 2
   Do While i <= n
      If c(i) < cs Then
         cs = c(i)
         s = i
      End If
      i = i + 1
   Loop

   '判断最小的Cs是否大于等于0（判断单纯形表是否为最优可行解的单纯形表）
   If cs >= 0 Then
      Print
      Print
      Print "                  k=" & k & "时的单纯形表为最优可行解对应的单纯形表："
      Call dcxbxs(a(), b(), c())
      MsgBox "按任意键继续"
      Exit Do
   End If
   
   '最小的Cs小于0（单纯形表不是最优可行解的单纯形表），考察与最小Cs对应列的变量的系数A（i，s）
   '找出最大的A（i，s）
   R = 1
   ars = a(1, s)
   i = 2
   Do While i <= m
      If a(i, s) > ars Then
         ars = a(i, s)
         R = i
      End If
      i = i + 1
   Loop

   '判断最大的A（i，s）是否小于0
   If ars < 0 Then
      Print
      Print "                  k=" & k & "时的单纯形表：（该线性规划问题的解为无界解）"
      Call dcxbxs(a(), b(), c())
      MsgBox "按任意键继续"
      Exit Do
   End If
 
   '最大的A（i，s）大于0，找主元素r
   k = k + 1
   ars = b(R) / a(R, s)
   i = 1
   Do While i <= m
      If b(i) / a(i, s) < ars And b(i) / a(i, s) > 0 Then
         ars = b(i) / a(i, s)
         R = i
      End If
      i = i + 1
   Loop
   Print Tab(10); "s=" & s; Spc(5); "r=" & R; Spc(5); "主元素:" & a(R, s)
   MsgBox "按任意键继续"
   
  '用A（r，s）作主元素，消元后得到新的单纯形表
   
   '对r行的所有元素进行处理（所有元素除以A(r,s)）
   ars = a(R, s)
   b(R) = b(R) / a(R, s)
   xs = b(R)
   i = 1
   Do While i <= n
      a(R, i) = a(R, i) / ars
      i = i + 1
   Loop
   
  '对S列元素进行处理（使除了A(r,s)＝1外，其他的元素全部变换为0）
   i = 1
   Do While i <= m
      If i <> R Then
         j = 1
         Do While j <= n
            If j <> s Then
               a(i, j) = a(i, j) - a(R, j) * a(i, s)
            End If
            j = j + 1
         Loop
         b(i) = b(i) - a(i, s) * b(R)
         a(i, s) = 0
      End If
      i = i + 1
   Loop
   i = 1
   cs = c(s)
   Do While i <= n
      c(i) = c(i) - a(R, i) * cs
      i = i + 1
   Loop
   
   f0 = f0 - cs * xs
   Print
   Print
   Print "                  k=" & k & "时的单纯形表"
   Call dcxbxs(a(), b(), c())
   MsgBox "按任意键继续"
    


Loop

End Sub