?? 線性規(guī)劃.bas
字號:
Private Sub Command1_Click()
DECLARE SUB a2 (m!, n!, a!(), kk())
DECLARE SUB a1 (m, n, t, s, a(), kk())
Cls
LOCATE 5, 20: Print "單純形法"
LOCATE 6, 20: Print "========"
LOCATE 7, 10: Print "輸入數(shù)學(xué)模型"
LOCATE 8, 10: INPUT "目標(biāo)函數(shù)求最大值(輸入1)或最小值(輸入-1) ", b
LOCATE 9, 10: INPUT "有幾個決策變量? ", n1
LOCATE 10, 10: INPUT "約束條件中含<=號的條件有幾個? ", m1
LOCATE 11, 10: INPUT "約束條件中含>=號的條件有幾個? ", m2
LOCATE 12, 10: INPUT "約束條件中含=號的條件有幾個? ", m3
m = m1 + m2 + m3
n = n1 + m1 + m2
Dim a(m, n), kk(m)
For i = 1 To 6: LOCATE 6 + i, 10: Print Space$(50): Next
LOCATE 7, 10: Print "輸入目標(biāo)函數(shù)系數(shù):"
For j = 1 To n1
LOCATE 8, 10: Print Space$(50)
LOCATE 8, 10: PRINT "X"; j; "的系數(shù)是 "; : INPUT a(0, j)
Next
For i = 1 To m1
LOCATE 7, 10: Print "輸入第"; i; "個含<=號的約束條件的系數(shù):"
For j = 1 To n1
LOCATE 8, 10: Print Space$(50)
LOCATE 8, 10: PRINT "X"; j; "的系數(shù)是 "; : INPUT a(i, j)
Next j
LOCATE 8, 10: Print Space$(50)
LOCATE 8, 10: INPUT "常數(shù)項是", a(i, 0)
a(i, n1 + i) = 1
Next i
For i = 1 To m2
LOCATE 7, 10: Print "輸入第"; i; "個含>=號的約束條件的系數(shù):"
For j = 1 To n1
LOCATE 8, 10: Print Space$(50)
LOCATE 8, 10: PRINT "X"; j; "的系數(shù)是 "; : INPUT a(m1 + i, j)
a(m1 + i, j) = -1 * a(m1 + i, j)
Next j
LOCATE 8, 10: Print Space$(50)
LOCATE 8, 10: INPUT "常數(shù)項是", a(m1 + i, 0)
a(m1 + i, 0) = -1 * a(m1 + i, 0)
a(m1 + i, n1 + m1 + i) = 1
Next i
For i = 1 To m3
LOCATE 7, 10: Print "輸入第"; i; "個含=號的約束條件的系數(shù):"
For j = 1 To n1
LOCATE 8, 10: Print Space$(50)
LOCATE 8, 10: PRINT "X"; j; "的系數(shù)是 "; : INPUT a(m1 + m2 + i, j)
Next j
LOCATE 8, 10: Print Space$(50)
LOCATE 8, 10: INPUT "常數(shù)項是", a(m1 + m2 + i, 0)
Next i
LOCATE 7, 10: Print Space$(50)
LOCATE 8, 10: Print Space$(50)
LOCATE 8, 10: INPUT "要打印單純形表嗎?(要請輸入: 1)"; dy
Rem 打印線性規(guī)劃問題的標(biāo)準(zhǔn)型
LOCATE 7, 5: Print Space$(70)
LOCATE 7, 5: Print "線性規(guī)劃問題的標(biāo)準(zhǔn)型為:"
If b = 1 Then
LOCATE 8, 5: Print "求 Max S=";
Else
LOCATE 8, 5: Print "求 Min S=";
End If
If a(0, 1) <> 0 Then Print a(0, 1); "x1";
For j = 2 To n
Select Case a(0, j)
Case Is < 0
Print a(0, j); "x"; j;
Case Is > 0
Print "+"; a(0, j); "x"; j;
End Select
Next j: Print " "
LOCATE 9, 5: Print "s.t."
For i = 1 To m
LOCATE 8 + i, 9:
If a(i, 1) <> 0 Then Print a(i, 1); "x1";
For j = 2 To n
Select Case a(i, j)
Case Is < 0
Print a(i, j); "x"; j;
Case Is > 0
Print "+"; a(i, j); "x"; j;
End Select
Next j: Print "="; a(i, 0); " "
Next i
For j = 1 To n1
a(0, j) = a(0, j) * b
Next
For i = 1 To m1 + m2
kk(i) = n1 + i
Next
If dy = 1 Then
Call a2(m, n, a(), kk())
End If
Rem 求基礎(chǔ)解
For i = m1 + m2 + 1 To m
g = 0
For j = 1 To n
If a(i, j) <> 0 Then
g = 1: t = i: s = j: Call a1(m, n, t, s, a(), kk())
Exit For
End If
Next j
If g = 0 Then
If Int(a(i, 0) * 10000 + 0.5) / 10000 = 0 Then
For i1 = i To m - 1
kk(i1) = kk(i1 + 1)
For j = 0 To n
a(i1, j) = a(i1 + 1, j)
Next j
Next
m = m - 1: i = i - 1
Else
Print "無基礎(chǔ)解"
End
End If
End If
If dy = 1 Then
Call a2(m, n, a(), kk())
End If
If i >= m Then
Exit For
End If
Next
Rem 求可行解
Do
g = 0
For i = 1 To m
If a(i, 0) < 0 Then
g = 1
t = i
xx = 999999
For j = 1 To n
If Int(a(i, j) * 100000 + 0.5) / 100000 < 0 Then
If a(0, j) / a(i, j) < xx Then
s = j
xx = a(0, j) / a(i, j)
End If
End If
Next
If xx = 999999 Then
Print "線性規(guī)劃問題無可行解"
End
Else
Call a1(m, n, t, s, a(), kk())
Exit For
End If
End If
Next i
If g = 0 Then
Exit Do
End If
If dy = 1 Then
Call a2(m, n, a(), kk())
End If
Loop
Rem 求最優(yōu)解
Do
g = 0
For j = 1 To n
If a(0, j) > 0 Then
g = 1
s = j
xx = 999999
For i = 1 To m
If Int(a(i, j) * 100000 + 0.5) / 100000 > 0 Then
If a(i, 0) / a(i, j) < xx Then
t = i
xx = a(i, 0) / a(i, j)
End If
End If
Next
If xx = 999999 Then
Print "線性規(guī)劃問題無最優(yōu)解"
End
Else
Call a1(m, n, t, s, a(), kk())
Exit For
End If
End If
Next j
If g = 0 Then
Exit Do
End If
If dy = 1 Then
Call a2(m, n, a(), kk())
End If
Loop
va: Rem 打印最優(yōu)解
Print "線性規(guī)劃問題的最優(yōu)解:"
For j = 1 To n
g = 0
For i = 1 To m
If j = kk(i) Then
g = 1: Exit For
End If
Next i
If g = 0 Then
Print "x("; j; ")="; 0
Else
Print "x("; j; ")="; a(i, 0)
End If
Next j
Print "相應(yīng)的";
If b = -1 Then
Print "Min S="; Int(a(0, 0) * 100 + 0.5) / 100
Else
Print "Max S="; -1 * Int(a(0, 0) * 100 + 0.5) / 100
End If
vb: Rem 求別的基礎(chǔ)最優(yōu)解
Print "當(dāng)j=";
For j = 1 To n
If Int(a(0, j) * 100 + 0.5) / 100 = 0 Then
g = 0
For i = 1 To m
If j = kk(i) Then
g = 1: Exit For
End If
Next i
If g = 0 Then
Print j;
End If
End If
Next j
Print "時還有別的基礎(chǔ)最優(yōu)解."
PRINT "要求別的基礎(chǔ)最優(yōu)解嗎?(Y/N)"; : INPUT yn$
If yn$ = "Y" Or yn$ = "y" Then
INPUT "請輸入j="; j
s = j
xx = 999999
For i = 1 To m
If Int(a(i, j) * 100000 + 0.5) / 100000 > 0 Then
If a(i, 0) / a(i, j) < xx Then
t = i
xx = a(i, 0) / a(i, j)
End If
End If
Next
If xx = 999999 Then
Print "線性規(guī)劃問題在這個方向無基礎(chǔ)最優(yōu)解"
GoTo vb
Else
Call a1(m, n, t, s, a(), kk())
If dy = 1 Then
Call a2(m, n, a(), kk())
End If
End If
GoTo va
End If
End
Sub a1(m, n, t, s, a(), kk())
kk(t) = s
ll = a(t, s)
For j1 = 0 To n: a(t, j1) = a(t, j1) / ll: Next j1
For i1 = 0 To m
If i1 <> t Then
x = a(i1, s)
For j1 = 0 To n
a(i1, j1) = a(i1, j1) - a(t, j1) * x
Next
End If
Next
End Sub
Sub a2(m, n, a(), kk())
Print
Print "-------------------------------------------------------------------------------------------------"
For j1 = 1 To n
Print Tab(11 + j1 * 8); "x"; j1;
Next j1: Print
Print "-------------------------------------------------------------------------------------------------"
For i1 = 0 To m
If i1 = 0 Then
Print Tab(3); "S";
Else
Print Tab(3); "x"; kk(i1);
End If
For j1 = 0 To n
Print Tab(11 + j1 * 8); Int(a(i1, j1) * 100 + 0.5) / 100;
Next j1
Print
Next i1
Print "-------------------------------------------------------------------------------------------------"
Print
End Sub
End Sub
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -