unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, Grids;
const
long = 100;
type
TForm1 = class(TForm)
panel2:TPanel;
Memo1:TMemo;
Panel1:TPanel;
Label1:TLabel;
Label2:TLabel;
Edit1:TEdit;
Edit2:TEdit;
RadioGroup1:TRadioGroup;
BitBtn1:TBitBtn;
BitBtn2:TBitBtn;
StringGrid2:TStringGrid;
mmo1:TMemo;
procedure BitBtn2Click(Sender:TObject);
procedure BitBtn1Click(Sender:TObject);
procedure RadioGroup1Click(Sender:TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure f_inputData;
end;
type
zengguangjuzhen = array[0..long, 0..long] of real;
var
Form1:TForm1;
implementation
{$R *.dfm}
var
a:zengguangjuzhen;
Varnum:Integer;
//变量数
Connum:Integer;
//约束条件数
leixiing:string;
//返回目标函数类型
procedure chushihua(var aa:zengguangjuzhen);
var
i, j:Integer;
begin
for i := 0 to longdo
for j := 0 to longdo
aa[i, j] := 0;
end;
{-------------初始化自定义类型的矩阵----------------}
procedure duqushuju;
var
i, j:Integer;
begin
for i := 1 to ConNumdo
for j := 1 to VarNum + 1do
if Form1.StringGrid2.Cells[j, i] <> '' then
a[i, j] := StrToFloat(Form1.StringGrid2.Cells[j, i]);
//读取系数矩阵和操作符
for i := 1 to ConNumdo
if Form1.StringGrid2.Cells[VarNum + 2, i] <> '' then
a[i, 0] := StrToFloat(Form1.StringGrid2.Cells[varnum + 2, i]);
//读取限定向量
for j := 1 to VarNumdo
if Form1.StringGrid2.Cells[j, ConNum + 1] <> '' then
a[0, j] := StrToFloat(Form1.StringGrid2.Cells[j, ConNum + 1]);
//读取目标函数系数
end;
{----------读取文本框中的数据-----------------------}
function duiouhua(a:zengguangjuzhen;
m, n:integer;
var
zengjiahang:Integer):zengguangjuzhen;
var
i, j:integer;
begin
zengjiahang := 0;
for i := 1 to mdo
if a[i, n + 1] = 1 then
for j := 0 to n + 1do
a[i, j] := -a[i, j] //大于两边同乘以-1
else
if a[i, n + 1] = 0 then
begin
zengjiahang := zengjiahang + 1;
//所增加的行数
for j := 0 to n + 1do
a[m + zengjiahang, j] := -a[i, j];
//相等的增加一行
end;
for i := 1 to m + zengjiahangdo
begin
a[i, n + 1] := 0;
a[i, n + i] := 1;
end;
Result := a;
end;
{------------对偶变换--------------------------}
function panduan_d(a:zengguangjuzhen;
n:Integer):Boolean;
var
j:Integer;
begin
Result := True;
for j := 1 to ndo
if a[0, j] < 0 then
begin
Result := False;
Break;
end;
end;
{---------判断目标函数------------------------}
function panduan_b(a:zengguangjuzhen;
m:Integer):Boolean;
var
i:Integer;
begin
Result := True;
for i := 1 to mdo
if a[i, 0] < -0.000001 then
begin
Result := False;
Break;
end;
end;
{---------判断目标函数------------------------}
function find_r(a:zengguangjuzhen;
m:Integer):Integer;
var
i:Integer;
temp_r, k:Integer;
temp:real;
begin
temp_r := 0;
for i := 1 to mdo
if a[i, 0] < -0.000001 then
begin
temp_r := i;
k := i;
temp := a[i, 0];
Break;
end;
for i := k to mdo
if (a[i, 0] < -0.000001) and (a[i, 0] < temp) then
begin
temp_r := i;
temp := a[i, 0];
Result := i;
Break;
end;
Result := temp_r;
end;
{---------寻找主行-----------------------}
function panduan_s(a:zengguangjuzhen;
r:integer;
n:Integer):Boolean;
var
j:Integer;
begin
Result := False;
for j := 1 to ndo
if a[r, j] < 0 then
begin
Result := True;
Break;
end;
end;
{---------判断主列------------------------}
function find_s(a:zengguangjuzhen;
r:integer;
n:Integer):Integer;
var
j:Integer;
k:Integer;
temp:Real;
begin
Result := 0;
temp := 0;
for j := 1 to ndo
if a[r, j] < 0 then
begin
Result := j;
k := j;
temp := a[0, j] / abs(a[r, j]);
Break;
end;
for j := k to ndo
if (a[r, j] < 0) and (a[0, j] / abs(a[r, j]) < temp) then
begin
temp := a[0, j] / abs(a[r, j]);
Result := j;
end;
end;
{---------寻找主行-----------------------}
function diedai(a:zengguangjuzhen;
r, s:integer;
m, n:integer):zengguangjuzhen;
var
i, j:Integer;
temp:real;
begin
temp := a[r, s];
for j := 0 to ndo
a[r, j] := a[r, j] / temp;
//变换主元素行
a[r, s] := 1;
//避免浮点数运算
for i := 0 to mdo
begin
temp := a[i, s];
if i <> r then
//变换主行以外的所有行
begin
for j := 0 to ndo
a[i, j] := a[i, j] - a[r, j] * temp;
//系数据阵，限定向量，检验数，目标函数值的变换
end;
end;
for i := 0 to mdo
if i = r then
a[i, s] := 1
else
a[i, s] := 0;
//变换主元素列
Result := a;
end;
{---------------对应原理第六步，完成了迭代变换-----------------------}
function four(a:zengguangjuzhen;
n:integer):Integer;
var
j:Integer;
temp:real;
begin
Result := 1;
temp := 0;
for j := 1 to ndo
if a[0, j] < temp then
begin
temp := a[0, j];
Result := j;
end;
end;
{----------对应原理第四步，附加一行和一列的情况下选取主列-------}
function xianxingguihua(a:zengguangjuzhen;
m, n:integer;
var
kexing:Boolean):zengguangjuzhen;
var
i, j:Integer;
m0:Integer;
temp:zengguangjuzhen;
juece:array[1..long] of Integer;
//存放基变量
r, s:Integer;
zuiyoujie:string;
x:array[1..long] of real;
label
5;
begin
zuiyoujie := '你没有输入人和数据';
for i := 1 to longdo
begin
juece := 0;
x := 0;
end;
for i := 1 to ndo
juece := i;
chushihua(temp);
temp := duiouhua(a, m, n, m0);
for i := 1 to m + m0do
begin
temp[i, n + i] := 1;
//加入松弛变量
juece := n + i;
end;
if leixiing = 'Max' then
for j := 1 to ndo
temp[0, j] := -temp[0, j];
//注意极大化问题的处理
if panduan_d(temp, n + m + m0) then
begin
5:if panduan_b(temp, m + m0) then
begin
kexing := True;
Result := temp;
if leixiing = 'Min' then
temp[0, 0] := -temp[0, 0];
//最小化问题解为表格的值得相反数
zuiyoujie := '该线性规划的' + leixiing + '为：'
+ FormatFloat('0.######', temp[0, 0]) + #13 + '最优解为：';
for i := 1 to m + m0do
if (juece > 0) and (juece <= n) then
x[juece] := temp[i, 0];
for j := 1 to ndo
zuiyoujie := zuiyoujie + #13 + ' x' + IntToStr(j)
+ ' = ' + FormatFloat('0.######', x[j]);
for i := 0 to Application.MainForm.ComponentCount - 1do
if Application.MainForm.Components is TMemo then
begin
tmemo(Application.MainForm.Components).clear;
tmemo(Application.MainForm.Components).Lines.Add(zuiyoujie);
end;
ShowMessage(zuiyoujie);
//最优解
end
else
begin
r := find_r(temp, m + m0);
if panduan_s(temp, r, n + m + m0) then
begin
s := find_s(temp, r, n + m + m0);
juece[r] := s;
//更新决策变量
temp := diedai(temp, r, s, m + m0, n + m + m0);
goto 5;
end
else
begin
ShowMessage('无可行解 ');
//无可行解
kexing := False;
end;
end;
end
else
begin
m0 := m0 + 1;
for j := 1 to ndo
temp[m + m0, j] := 1;
temp[m + m0, 0] := 0;
for i := 0 to m + m0do
for j := 0 to n + m + m0do
if temp[i, j] > temp[m + m0, 0] then
temp[m + m0, 0] := temp[i, j];
temp[m + m0, 0] := temp[m + m0, 0] + 100;
temp[m + m0, n + m + m0] := 1;
juece[m + m0] := n + m + m0;
s := four(temp, n + m + m0);
r := m + m0;
juece[r] := s;
//更新决策变量
temp := diedai(temp, r, s, m + m0, n + m + m0);
goto 5;
end;
end;
{---------算法核心，调用小的函数和过程完成计算---------------}
procedure TForm1.BitBtn1Click(Sender:TObject);
var
i, j:integer;
begin
try
ConNum := strtoint(edit1.text);
VarNum := strtoint(edit2.text);
{输入变量个数和约束条件个数}
except
on EMathErrordo
begin
showmessage('输入有误!' + #13 + '请确定您输入的是整数并且没有空格');
//纠错
exit;
end;
end;
stringgrid2.ColCount := VarNum + 3;
stringgrid2.RowCount := ConNum + 2;
stringgrid2.Cells[0, 0] := '约束/变量';
stringgrid2.Cells[0, ConNum + 1] := '目标函数';
//表格的列数=变量数+3；第一列用作标签，最后两列为运算符及常数项 }
for j := 1 to VarNumdo
stringgrid2.Cells[j, 0] := 'X' + inttostr(j);
//表格外观，第一行、第一列用作标签.第一行显示变量名
for i := 1 to ConNumdo
StringGrid2.Cells[0, i] := '约束 ' + IntToStr(i);
stringgrid2.Cells[VarNum + 1, 0] := '运算符';
//表格第一行倒数第二列，显示约束条件中的运算符
stringgrid2.Cells[VarNum + 2, 0] := 'b';
//表格第一行最后一列，显示约束条件的常数项b
leixiing := RadioGroup1.Items[RadioGroup1.Itemindex];
//设置目标函数类型
StringGrid2.SetFocus;
end;
{----------设置数据输入界面-----------------------}
procedure TForm1.RadioGroup1Click(Sender:TObject);
begin
leixiing := RadioGroup1.Items[RadioGroup1.Itemindex];
//设置目标函数类型
end;
procedure TForm1.BitBtn2Click(Sender:TObject);
var
temp:zengguangjuzhen;
m, n:Integer;
jie:Boolean;
//判断有无可行解
begin
chushihua(a);
//初始化变量
duqushuju;
//读取输入数据
chushihua(temp);
//初始化临时变量
m := Connum;
n := Varnum;
//行数和列数的传递
temp := xianxingguihua(a, m, n, jie);
//程序核心，调用对偶单纯形法进行计算
end;
procedure TForm1.f_inputData;
begin
BitBtn1.OnClick(nil);
StringGrid2.Cells[1,1] := '317';
StringGrid2.Cells[1,2] := '11.9';
StringGrid2.Cells[1,3] := '1.3';
StringGrid2.Cells[2,1] := '898';
StringGrid2.Cells[2,2] := '0';
StringGrid2.Cells[2,3] := '99.7';
StringGrid2.Cells[3,1] := '1.3';
StringGrid2.Cells[3,2] := '99.7';
StringGrid2.Cells[3,3] := '0.2';
StringGrid2.Cells[5,1] := '5720';
StringGrid2.Cells[5,2] := '216';
StringGrid2.Cells[5,3] := '152';
// 运算符
StringGrid2.Cells[4,1] := '1';
StringGrid2.Cells[4,2] := '1';
StringGrid2.Cells[4,3] := '1';
// 目标函数
StringGrid2.Cells[1,4] := '1';
StringGrid2.Cells[2,4] := '1';
StringGrid2.Cells[3,4] := '1';
StringGrid2.Cells[4,4] := '1';
StringGrid2.Cells[5,4] := '1';
end;
procedure TForm1.FormShow(Sender: TObject);
begin
f_inputData;
end;
end.
object Form1: TForm1
Left = 282
Top = 185
Width = 570
Height = 432
Caption = '对偶单纯形法解线性规划问题'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object panel2: TPanel
Left = 0
Top = 89
Width = 562
Height = 316
Align = alClient
BevelInner = bvLowered
TabOrder = 0
object Memo1: TMemo
Left = 2
Top = 247
Width = 558
Height = 67
Align = alBottom
BorderStyle = bsNone
DragMode = dmAutomatic
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlue
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Lines.Strings = (
'说明：'
'１、第一行至倒数第二行输入约束矩阵，其中，倒数第二列为操作符（为方便输入 用１表'
' 示大于或等于,-1表示小于或等于,0或空格表示等于），最后一列输入不等式值。'
'２、最后一行输入目标函数系数。')
ParentColor = True
ParentFont = False
TabOrder = 0
end
object StringGrid2: TStringGrid
Left = 2
Top = 2
Width = 558
Height = 245
Align = alClient
ColCount = 6
Ctl3D = False
FixedColor = clMenu
RowCount = 8
Font.Charset = GB2312_CHARSET
Font.Color = clBlue
Font.Height = -13
Font.Name = '宋体'
Font.Style = []
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goRowMoving, goColMoving, goEditing, goTabs, goAlwaysShowEditor]
ParentCtl3D = False
ParentFont = False
TabOrder = 1
end
object mmo1: TMemo
Left = 438
Top = 254
Width = 185
Height = 89
Lines.Strings = (
'mmo1')
TabOrder = 2
end
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 562
Height = 89
Align = alTop
BevelInner = bvLowered
TabOrder = 1
object Label1: TLabel
Left = 16
Top = 25
Width = 121
Height = 25
AutoSize = False
Caption = '约束条件个数M'
Font.Charset = DEFAULT_CHARSET
Font.Color = clPurple
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Label2: TLabel
Left = 16
Top = 57
Width = 113
Height = 24
AutoSize = False
Caption = '变量个数N'
Font.Charset = DEFAULT_CHARSET
Font.Color = clPurple
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Edit1: TEdit
Left = 144
Top = 16
Width = 89
Height = 24
BevelInner = bvLowered
BevelOuter = bvRaised
Font.Charset = DEFAULT_CHARSET
Font.Color = clMaroon
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 0
Text = '3'
end
object Edit2: TEdit
Left = 144
Top = 57
Width = 89
Height = 24
Font.Charset = DEFAULT_CHARSET
Font.Color = clMaroon
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 1
Text = '3'
end
object RadioGroup1: TRadioGroup
Left = 264
Top = 8
Width = 161
Height = 73
Caption = '目标函数类型'
Columns = 2
Font.Charset = DEFAULT_CHARSET
Font.Color = clPurple
Font.Height = -16
Font.Name = 'MS Sans Serif'
Font.Style = []
ItemIndex = 0
Items.Strings = (
'Max'
'Min')
ParentFont = False
TabOrder = 2
OnClick = RadioGroup1Click
end
object BitBtn1: TBitBtn
Left = 448
Top = 16
Width = 75
Height = 25
Caption = '确定'
Font.Charset = DEFAULT_CHARSET
Font.Color = clNavy
Font.Height = -16
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 3
OnClick = BitBtn1Click
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000120B0000120B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00555555555555
555555555555555555555555555555555555555555FF55555555555559055555
55555555577FF5555555555599905555555555557777F5555555555599905555
555555557777FF5555555559999905555555555777777F555555559999990555
5555557777777FF5555557990599905555555777757777F55555790555599055
55557775555777FF5555555555599905555555555557777F5555555555559905
555555555555777FF5555555555559905555555555555777FF55555555555579
05555555555555777FF5555555555557905555555555555777FF555555555555
5990555555555555577755555555555555555555555555555555}
NumGlyphs = 2
end
object BitBtn2: TBitBtn
Left = 448
Top = 48
Width = 75
Height = 25
Caption = '求解'
Font.Charset = DEFAULT_CHARSET
Font.Color = clNavy
Font.Height = -16
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 4
OnClick = BitBtn2Click
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000120B0000120B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333300000000
0000333377777777777733330FFFFFFFFFF033337F3FFF3F3FF733330F000F0F
00F033337F777373773733330FFFFFFFFFF033337F3FF3FF3FF733330F00F00F
00F033337F773773773733330FFFFFFFFFF033337FF3333FF3F7333300FFFF00
F0F03333773FF377F7373330FB00F0F0FFF0333733773737F3F7330FB0BF0FB0
F0F0337337337337373730FBFBF0FB0FFFF037F333373373333730BFBF0FB0FF
FFF037F3337337333FF700FBFBFB0FFF000077F333337FF37777E0BFBFB000FF
0FF077FF3337773F7F37EE0BFB0BFB0F0F03777FF3733F737F73EEE0BFBF00FF
00337777FFFF77FF7733EEEE0000000003337777777777777333}
NumGlyphs = 2
end
end
end
