jisuan1.~pas

用delphi实现运筹学中线性规划通用单纯形程序－两阶段法

unit jisuan1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Buttons;

type
  Tfrmjisuan1 = class(TForm)
    Panel1: TPanel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn5: TBitBtn;
    Label3: TLabel;
    BitBtn4: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure xianshi;
  end;

var
  frmjisuan1: Tfrmjisuan1;

function  puanduan_d:Boolean;//判断目标函数
function  find_s:integer;//寻找主列
function  puanduan_r(s:Integer):Boolean;//判断主行是否存在
function  find_r(s:integer):Integer;//寻找主行
procedure  diedai;//迭代变换
{-----------------jisuan1、jisuan2两单元公用的函数和过程----------------}
implementation
  {$R *.DFM}
uses jisuan2,shuru;//调用另外两个单元的数据
var  xianshi1:myarray2;//单元变量，用于显示结果
procedure tiaozhen;
var temp_A:myarray;//临时变量，辅助A的调整
    temp_b:array[1..long] of real;//临时变量，辅助b的调整
    k:Integer;//记录temp_A的行数
    i,j:Integer;
begin
k:=0;ziyou:=0;man:=0;
for i:=1 to long do
  for j:=1 to long do
    temp_A[i,j]:=0;
//初始化变量
for i:=1 to m do
  for j:=1 to n do
    temp_A[i,j]:=A[i,j];
//将系数矩阵付给临时变量
for i:=1 to m do
  if  opt[i]=-1 then
    begin
      k:=k+1;//已变换的行数的累加
      ziyou:=ziyou+1;//松弛变量个数累加
      for j:=1 to n do
        temp_A[k,j]:=A[i,j];//实现系数矩阵行的交换
      temp_A[k,n+ziyou]:=1;//添加松弛变量系数
      juece[k]:=n+ziyou;//记录决策变量
      temp_b[k]:=b[i];//交换限定向量（常数项）
    end;
{------------对于操作符是小于号情况的处理----------------------------}
for i:=1 to m do
  if  opt[i]=1 then
    begin
      opt[i]:=0;//将大于号转化为等于号，以进行下一步处理
      ziyou:=ziyou+1;
      temp_A[i,n+ziyou]:=-1;
    end;
{------------对于操作符是大于号情况的初步处理-------------------------}
for i:=1 to m do
  if  opt[i]=0 then
    begin
      k:=k+1;
      man:=man+1;//累加人工变量的个数
      for j:=1 to n do
        temp_A[k,j]:=A[i,j];//交换系数矩阵的行
      temp_A[k,n+ziyou+man]:=1;
      temp_b[k]:=b[i];
      juece[k]:=n+ziyou+man;
    end;
{---------对于操作符是等于号，以及由大于号转换而来的情况的处理--------}
for i:=1 to m do
  for j:=1 to n+ziyou+man do
    A[i,j]:=temp_A[i,j]; //将调整后的系数矩阵付给全局变量A
for i:=1 to m do
  b[i]:=temp_b[i];//将调整后的限定向量付给全局变量b
end;
{-----对应原理的第一步，约束变换。加入松弛变量和人工变量，构造
不带目标函数的初始表格，并调整使基变量（juece）的后man行为人工变量----}

procedure  jisuan_d_z;
var i,j:integer;
begin
for j:=low(d) to high(d) do
  d[j]:=0; //初始化人工目标函数系数
for j:=1 to n+ziyou do
  for i:=m-man+1 to m do
    d[j]:=d[j]-A[i,j];
//计算人工目标函数系数
w:=0;//初始化人工目标函数值
for i:=m-man+1 to m do
  w:=w-b[i];
//计算人工目标函数值
end;
{----------对应原理的第二步-------------------------------------------}

function  puanduan_d:Boolean;
var j:Integer;
begin
Result:=true;
for j:=1 to n+ziyou+man do
  if d[j]<-0.000001 then // 存在目标函数系数为负数
    begin
      Result:=False;
      Break;
    end;
end;
{----------对应原理第三步，判断目标函数有无负值------------------------}

function  find_s:integer;
var temp:real;
    i:integer;
begin
temp:=d[1];
Result:=1;
for i:=2 to high(d) do
  if d[i]<temp then
    begin
      temp:=d[i];
      Result:=i;
    end;
end;
{----------找主元列。从行向量中选取最小的数，返回其位置----------------}

function  puanduan_r(s:Integer):Boolean;
var i:Integer;
begin
Result:=False;
for i:=1 to m do
  if A[i,s]>0 then
    begin
      Result:=True;
      Break;
    end;
end;
{---------判断的r列的元素有无正值--------------------------------------}

function  find_r(s:integer):Integer;
var i,k:Integer;
    temp:real;//临时变量，记录比值大小
begin
k:=0;
for i:=1 to m do
  if A[i,s]>0 then
    begin
      k:=i;
      break;
    end;//首先寻求一个正的元素
Result:=k;
temp:=b[k]/A[k,s];
for i:=k+1 to m do
  if (A[i,s]>0) and (b[i]/A[i,s]<temp) then
    Result:=i;//着比值最小的行
end;
{----------找主元行。从主元列中选取比之最小的行，返回其位置-----------}

procedure  diedai;
var temp:Real;//保存主元素的值
    i,j:Integer;
    yi:array[1..long]  of real;
begin
juece[r]:=s;//更新决策变量
temp:=A[r,s];
for j:=1 to n+ziyou+man do
  A[r,j]:=A[r,j]/temp;
b[r]:=b[r]/temp;//变换主元素行
for i:=1 to m  do
 begin
   yi[i]:=A[i,s];
   if  i<>r then //变换主行以外的所有行
     begin
       for j:=1 to n+ziyou+man do
         A[i,j]:=A[i,j]-A[r,j]*yi[i];//系数据阵的变换
       b[i]:=b[i]-b[r]*yi[i];//检验数的变换
      end;
 end;
yi[m+1]:=d[s];//借用yi的第m+1行存放主元列所对应的目标函数系数
for j:=1 to n+ziyou+man do
  d[j]:=d[j]-A[r,j]*yi[m+1];
//变换目标函数系数
w:=w-yi[m+1]*b[r];//更新目标函数值
for i:=1 to m do
  if i=r then A[i,s]:=1
  else  A[i,s]:=0;//变换主元素列
end;
{----以上四个过程对应原理第四步，完成了迭代变换---------------------}

function nbv:boolean;
var i:Integer;
begin
Result:=true;
for i:=1 to m do
 if juece[i]>n+ziyou then
   begin
     Result:=false;
     break;
   end;
end;
{--------对应原理的第五步，判断基变量中是否还有人工变量--------------}

function nbv_0:boolean;
var i:integer;
begin
Result:=true;
for i:=1 to m do
  if (juece[i]>n+ziyou) and (b[i]<>0) then
    begin
      Result:=False;
      Break;
    end;
end;
{--------对应原理的第六步的前一部分，判断所有有人工变量的值是否全为0--}

procedure  delete_nbv;
var i,j,k:Integer;
    temp_a:myarray;
    temp_b:array[1..long] of real;
    temp_juece:array of integer;
    temp_lie:array of integer;
begin
for i:=1 to long do
  for j:=1 to long do
    temp_A[i,j]:=0;
for i:=1 to long do
    temp_b[i]:=0;
   //初始化临时变量
for i:=1 to m do
  if juece[i]>n+ziyou then
    begin
      SetLength(temp_lie,high(temp_lie)+2);
      temp_lie[high(temp_lie)]:=juece[i];
    end//记录人工变量的位置
  else
    begin
      for j:=1 to n+ziyou+man do
        temp_a[i,j]:=a[i,j];//更新系数矩阵
      temp_b[i]:=b[i];//更新限定向量
      SetLength(temp_juece,high(temp_juece)+2);
      temp_juece[high(temp_juece)]:=juece[i];//更新决策变量
    end;
for k:=low(temp_lie) to high(temp_lie) do
  for i:=1 to m-length(temp_lie) do
     temp_a[i,temp_lie[k]]:=0;//删除对应的列
for i:=1 to m do
  for j:=1 to n+ziyou+man do
    A[i,j]:=temp_a[i,j];//将更新后的矩阵
for i:=1 to m do
  b[i]:=temp_b[i];
for i:=low(temp_juece) to high(temp_juece) do
  juece[i+1]:=temp_juece[i];
for i:=length(temp_juece)+1 to m do
  juece[i]:=0;
man:=man-length(temp_lie);//更新人工变量的值
end;
{--------对应原理的第六步的后一部分，删除人工变量所在的行、列------}

procedure  delete_man;
var i,j:integer;
begin
for j:=n+ziyou+1 to n+ziyou+man do
  begin
    for i:=1 to m do
      A[i,j]:=0;//删除人工变量所对应的系数的列
    d[j]:=0;//删除人工变量的目标系数
  end;
man:=0;//更新人工变量的值
end;
{--------对应原理的第七步，删除人工变量的所有列列------------------}
procedure tfrmjisuan1.xianshi;
var i,j:Integer;
    x0,y0:Integer;//控制输入框的位置
begin
for i:=0 to frmjisuan1.Panel1.ComponentCount-1 do
  frmjisuan1.Panel1.Components[i].Free;
//释放原有文本框
x0:=(panel1.Width-(n+ziyou+man+2)*40) div 2;
y0:=(panel1.Height-(m+1)*28) div 2;
for i:=0 to m+1 do
 for j:=0 to n+ziyou+man+1  do
   begin
    xianshi1[i,j]:=tedit.Create(self);
    xianshi1[i,j].parent:=frmjisuan1.Panel1;
    xianshi1[i,j].Width:=40;
    xianshi1[i,j].left:=x0+j*xianshi1[i,j].Width;
    xianshi1[i,j].top:=y0+i*xianshi1[i,j].Height;
  end;
for i:=1  to m do
  for j:=1 to  n+ziyou+man do
    xianshi1[i,j].text:=FormatFloat('0.####',A[i,j]);
//显示系数矩阵
xianshi1[0,0].text:='基';
for i:=1 to m do
  xianshi1[i,0].text:='x'+inttostr(juece[i]); //显示基变量
//注意m值的改变
xianshi1[m+1,0].Text:='检';
for j:=1 to n+ziyou+man do
  xianshi1[m+1,j].Text:=FormatFloat('0.#####',d[j]);
//显示目标函数
xianshi1[0,n+ziyou+man+1].text:='b';
for j:=1 to n+ziyou+man do
  xianshi1[0,j].text:='x'+inttostr(j);
//表头位置，变量名
for i:=1 to m do
  xianshi1[i,n+ziyou+man+1].Text:=FormatFloat('0.####',b[i]);
xianshi1[m+1,n+ziyou+man+1].Text:=FormatFloat('0.####',w);
{---------自定义过程，显示表格迭代结果--------------------------}
end;

procedure Tfrmjisuan1.FormCreate(Sender: TObject);
begin
BitBtn2.Enabled:=false;
BitBtn4.Enabled:=False;
end;
procedure Tfrmjisuan1.BitBtn3Click(Sender: TObject);
begin
tiaozhen;//调整约束方程的位置
jisuan_d_z;//计算目标函数系数和目标函数值
xianshi;//先是第一阶段初始单纯形表
BitBtn3.Enabled:=false;
BitBtn2.enabled:=true;
end;
{----------显示标初始单纯性表，控制按钮操作----------------------------}

procedure Tfrmjisuan1.BitBtn2Click(Sender: TObject);
label 1;
begin
1:if puanduan_d then // 判断目标函数系数是否全为正值
   if nbv then //基变量全为非人工变量的情况
      begin
       xianshi;//显示第一阶段最终单纯形表
       BitBtn4.Enabled:=True;
       ShowMessage('请单击OK进入第二阶段求解');
       BitBtn2.Enabled:=False;
      end
   else
     begin
       if nbv_0 then //人工基变量的值全为0
         begin
           xianshi; //显示第一阶段最终单纯形表 
           BitBtn4.Enabled:=True;
           ShowMessage('请单击OK进入第二阶段求解');
           BitBtn2.Enabled:=False;
         end
       else
         begin
           xianshi;
           ShowMessage('原线性规划无可行解');
           exit; //退出该事件
         end;
     end
{----------第一阶段的人工目标函数系数全为非负值的处理-----------------}
else//存在负值时，进一步迭代
  begin
    s:=find_s;//寻找主列
    if puanduan_r(s) then//判断主列，有无正值
      begin //有，则选取主行，进行新一轮的迭代
        r:=find_r(s);//调用自定义函数，寻找主行
        diedai;//旋转变换，得到新的单纯形表
        goto 1; //重新判断
      end
    else//主列元素，无正值，则原线性规划为无界解
      begin
        xianshi;
        ShowMessage('原线性规划具有一个无界解');
        Exit;
      end;
  end;
{----------第一阶段的人工目标函数系数非全为正值的处理-----------------}
end;

procedure Tfrmjisuan1.BitBtn5Click(Sender: TObject);
begin
frmshuru.close;//终止程序运行
end;

procedure Tfrmjisuan1.BitBtn1Click(Sender: TObject);
begin
frmshuru.Show;
//返回到数据输入窗口，修改或更新初始数据
end;

procedure Tfrmjisuan1.BitBtn4Click(Sender: TObject);
var j:Integer;
begin
if nbv then delete_man
//所有人工变量均非基变量时，调用过程delete_man删除全部人工变量
else if nbv_0 then delete_nbv;
//人工变量依然在机变量中，但其值均为0时，调用delete_nbv删除人工变量
//所对应的主元行、列
for j:=1 to n+ziyou+man do
  d[j]:=c[j];//传递原目标函数系数
frmjisuan2.Show;
frmjisuan2.BitBtn4.Enabled:=True;
end;

end.