📄 线性规划.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 "输入数学模型"
LOCATE 8, 10: INPUT "目标函数求最大值(输入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 "输入目标函数系数:"
For j = 1 To n1
LOCATE 8, 10: Print Space$(50)
LOCATE 8, 10: PRINT "X"; j; "的系数是 "; : INPUT a(0, j)
Next
For i = 1 To m1
LOCATE 7, 10: Print "输入第"; i; "个含<=号的约束条件的系数:"
For j = 1 To n1
LOCATE 8, 10: Print Space$(50)
LOCATE 8, 10: PRINT "X"; j; "的系数是 "; : INPUT a(i, j)
Next j
LOCATE 8, 10: Print Space$(50)
LOCATE 8, 10: INPUT "常数项是", a(i, 0)
a(i, n1 + i) = 1
Next i
For i = 1 To m2
LOCATE 7, 10: Print "输入第"; i; "个含>=号的约束条件的系数:"
For j = 1 To n1
LOCATE 8, 10: Print Space$(50)
LOCATE 8, 10: PRINT "X"; j; "的系数是 "; : 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 "常数项是", 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; "个含=号的约束条件的系数:"
For j = 1 To n1
LOCATE 8, 10: Print Space$(50)
LOCATE 8, 10: PRINT "X"; j; "的系数是 "; : INPUT a(m1 + m2 + i, j)
Next j
LOCATE 8, 10: Print Space$(50)
LOCATE 8, 10: INPUT "常数项是", 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 打印线性规划问题的标准型
LOCATE 7, 5: Print Space$(70)
LOCATE 7, 5: Print "线性规划问题的标准型为:"
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 求基础解
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 "无基础解"
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 "线性规划问题无可行解"
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 求最优解
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 "线性规划问题无最优解"
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 打印最优解
Print "线性规划问题的最优解:"
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 "相应的";
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 求别的基础最优解
Print "当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 "时还有别的基础最优解."
PRINT "要求别的基础最优解吗?(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 "线性规划问题在这个方向无基础最优解"
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -