unit1.~pas

用delphi实现运筹学线性规划对偶单纯形法程序

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;
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject); 
  private
    { Private declarations }
  public
    { Public declarations }
  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 long do
  for j:=0 to long do
    aa[i,j]:=0;
end;
{-------------初始化自定义类型的矩阵----------------}

procedure  duqushuju;
var i,j:Integer;
begin
for i:=1 to  ConNum do
  for j:=1 to VarNum+1 do
    if  Form1.StringGrid2.Cells[j,i]<>'' then
      a[i,j]:=StrToFloat(Form1.StringGrid2.Cells[j,i]);
  //读取系数矩阵和操作符
for i:=1 to ConNum do
  if Form1.StringGrid2.Cells[VarNum+2,i]<>'' then
    a[i,0]:=StrToFloat(Form1.StringGrid2.Cells[varnum+2,i]);
  //读取限定向量

for j:=1 to VarNum do
  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 m do
  if a[i,n+1]=1 then
    for j:=0 to n+1 do
      a[i,j]:=-a[i,j] //大于两边同乘以-1
  else if a[i,n+1]=0 then
    begin
      zengjiahang:=zengjiahang+1;//所增加的行数
      for j:=0 to n+1 do
        a[m+zengjiahang,j]:=-a[i,j];//相等的增加一行
    end;
for i:=1 to m+zengjiahang do
 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 n do
  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 m do
  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 m do
  if a[i,0]<-0.000001 then
    begin
      temp_r:=i;
      k:=i;
      temp:=a[i,0];
      Break;
    end;
for i:=k to m do
  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 n do
  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 n do
  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 n do
  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 n do
  a[r,j]:=a[r,j]/temp;//变换主元素行
a[r,s]:=1;//避免浮点数运算
for i:=0 to m  do
 begin
   temp:=a[i,s];
   if  i<>r then //变换主行以外的所有行
     begin
       for j:=0 to n do
         a[i,j]:=a[i,j]-a[r,j]*temp;
     //系数据阵，限定向量，检验数，目标函数值的变换
      end;
 end;
for i:=0 to m do
  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 n do
  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 long do
  begin
  juece[i]:=0;
  x[i]:=0;
end;
for i:=1 to n do
  juece[i]:=i;
chushihua(temp);
temp:=duiouhua(a,m,n,m0);
for i:=1 to m+m0 do
  begin
    temp[i,n+i]:=1;//加入松弛变量
    juece[i]:=n+i;
  end;
if leixiing='Max' then
  for j:=1 to n do
    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+m0+1 do
          if (juece[i]>0)  and (juece[i]<=n) then
             x[juece[i]]:=temp[i,0];
        for j:=1 to n do
          zuiyoujie:=zuiyoujie+#13+'      x'+IntToStr(j)
              +' = '+FormatFloat('0.######',x[j]);
        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 n do
      temp[m+m0,j]:=1;
    temp[m+m0,0]:=0;
    for i:=0 to m+m0 do
      for j:=0 to n+m+m0 do
        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 EMathError do
   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 VarNum do
     stringgrid2.Cells[j,0]:='X'+inttostr(j);
  //表格外观，第一行、第一列用作标签.第一行显示变量名
  for i:=1 to ConNum do
      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;



end.