jisuan.~pas

用delphi语言实现运筹学通用单纯形程序－大M法

unit jisuan;

interface

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

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

var
  frmjisuan: Tfrmjisuan;
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 shuru;//调用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;
    temp:real;
begin
temp:=0;
if leixing='Max' then
  for j:=N+ziyou+1 to n+ziyou+man do
    d[j]:=-MM //求最大化问题时人工变量系数取一个非常大的负数
else
  for j:=N+ziyou+1 to n+ziyou+man do
    d[j]:=MM; //求最大化问题时人工变量系数取一个非常大的正数
{-----------在目标函数中，加入人工变量和大M----------------------------}
if leixing='Min' then
  for j:=1 to n+ziyou+man do
     d[j]:=-d[j];//将最小化问题，转化为最大化问题
for j:=1 to n+ziyou+man do
  d[j]:=-d[j];//对于最大化问题，检验数为目标函数系数的相反数

z:=0;
for i:=1 to m do
  begin
    temp:=d[juece[i]];//临时变量存取比例因子
    for j:=1 to n+ziyou+man do
      d[j]:=d[j]-temp*A[I,J];//求取检验数
    z:=z-b[i]*temp;//求目标函数初始值
  end;
end;
{----------对应原理的第二步和第三步-------------------------------------}

function  puanduan_d:Boolean;
var j:Integer;
begin
Result:=true;
for j:=1 to n+ziyou+man do
  if d[j]<0 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
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<0.00000001) then
    begin              
     Result:=i;//找比值最小的行
     temp:= b[i]/A[i,s];
    end;
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 long do
  yi[i]:=0;//初始化临时变量
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];
//变换目标函数系数
z:=z-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:=False;
for i:=1 to m do
 if juece[i]>n+ziyou then
   begin
     Result:=True;
     break;//只要基变量终存在人工变量则跳出循环，并值结果为True
   end;
end;
{--------对应原理的第七步，判断基变量中是否还有人工变量--------------}

procedure tfrmjisuan.xianshi;
var i,j:Integer;
    x0,y0:Integer;//控制输入框的位置
begin
for i:=0 to frmjisuan.Panel1.ComponentCount-1 do
  frmjisuan.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:=frmjisuan.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.####',z);
{---------自定义过程，显示表格迭代结果--------------------------}
end;

procedure Tfrmjisuan.FormCreate(Sender: TObject);
begin
BitBtn2.Enabled:=false;

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

procedure Tfrmjisuan.BitBtn2Click(Sender: TObject);
var  i,j:integer;
     ziyoujie:string;
     //用于显示最优解和最优值
     t:Boolean;//辅助判断变量是否为基变量
label 1;
begin
1:if puanduan_d then // 判断目标函数系数是否全为正值
   if nbv then //基变量存在人工变量的情况
     begin
       xianshi;//显示第一阶段最终单纯形表
       ShowMessage('原线性规划无可行解');
       BitBtn2.Enabled:=False;
       Exit;
     end
   else
     begin
       xianshi; //显示第一阶段最终单纯形表
       ziyoujie:='最优解:'+#13; //初始化变量
       for i:=1 to n do
         begin
           t:=False;
           for j:=1 to m do
             if xianshi1[j,0].Text='x'+IntToStr(i) then
                begin//变量在基变量中，用变量ziyoujie累加得到最优解
                   ziyoujie:=ziyoujie+xianshi1[j,0].Text+'='+xianshi1[j,n+ziyou+man+1].Text+#13;
                   t:=true;
                   break;
                end;
             if not t then//变量不在基变量中，则其值为0
               ziyoujie:=ziyoujie+'x'+IntToStr(i)+'=0'+#13;//累加最优解
          end;
       z:=StrToFloat(xianshi1[m+1,n+ziyou+man+1].Text);
       if leixing='Min' then z:=-z;
       ShowMessage(ziyoujie+'最优值:'+FormatFloat('0.####',z));
//显示最优解和最优值
       BitBtn2.Enabled:=False;
     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 Tfrmjisuan.BitBtn5Click(Sender: TObject);
begin
Form1.close;//终止程序运行
end;

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

end.