unit2.~pas

很好运筹学的DEOPHI原代码.包括动态规划,原始单纯形法,对策论,决策论等

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls, Buttons,IdGlobal,Math;
const long=5;
type
  TForm2 = class(TForm)
    StringGrid1: TStringGrid;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Label1: TLabel;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
 var
  VarNum,ConNum:integer;
  //定义整形变量，存放变量个数和约束条件个数相当于n，m
  leixing:String;//存放目标函数类型
  x:array[1..long] of integer;//存放变量的值
  z:real;//存放最优目标函数值
  zuiyouzhi:real;//存放最优目标函数值
  fangsuo:real;//c存放目标函数的放大，缩小量
  meijucishu:integer;
  biaoshi:array of char;
  a:array[1..long,1..long] of real;//存放系数矩阵
  b:array[1..long] of real;//存放限定向量
  c:array[1..long] of real;//存放目标函数系数
  c0:array[1..long] of real;//保留原始目标函数系数
  paixu:array[1..long] of Integer;
  fuxishu:set of 1..100;//自定义集合
  opt:array[1..long] of integer;//存放操作符
  bins:string;//以字符方式存放整数转化而来的二进制数
implementation

{$R *.dfm}
uses unit1;

procedure bianhuanxishu;
var i,j:integer;
    k:Integer;
    yipai:set of 1..250;
    max:real;
    maxj:Integer;
begin
if leixing='Min' then
  for j:=1 to VarNum do
    c[j]:=-c[j];
    //为了便于求解将所有问题都转化为最大化问题
fangsuo:=0;
fuxishu:=[];
for j:=1 to VarNum do
  if c[j]<0 then
    begin
      fuxishu:=fuxishu+[j];
      fangsuo:=fangsuo+c[j];//更新目标函数值
      c[j]:=-c[j];//负的系数变为正的
      for i:=1 to ConNum  do
        begin
          b[i]:=b[i]-a[i,j];//更新限定向量
          a[i,j]:=-a[i,j];//更新系数矩阵
        end;
    end;
k:=0;
yipai:=[];

while k<varnum do
  begin
    k:=k+1;
    max:=-1;
    for j:=1 to VarNum do
      if (c[j]>max) and not (j in yipai) then
        begin
         max:=c[j];
         maxj:=j;
        end;
      yipai:=yipai+[maxj];
      paixu[k]:=maxj;
  end;
end;
{----------将目标函数中系数为负的项全部用1-x代替，并作以标识-------}

function  lookbest:boolean;//函数值返回是否有可行解
var   i,j,k:Integer;
      temp:Boolean;
      hangzhi:real;
      temp_z:real;
begin
Result:=False;
zuiyouzhi:=0;
temp_z:=0;
for k:=meijucishu-1 downto 0 do
  begin
    bins:=IntToBin(k);
    for j:= 1 to VarNum do
      x[paixu[j]]:=StrToInt(copy(bins,32-VarNum+j,1));
    temp_z:=0;
    for j:=1 to VarNum do
      begin
       if j in fuxishu then
         temp_z:=temp_z+(1-x[j])*c0[j]
       else
       temp_z:=temp_z+x[j]*c0[j];
      end;
    if temp_z>zuiyouzhi then
      begin
        temp:=True;
        for i:=1 to ConNum do
          begin
            hangzhi:=0;
            for j:=1 to VarNum do
              hangzhi:=hangzhi+a[i,j]*x[j];
            if (Sign(hangzhi-b[i])<>opt[i]) and (hangzhi<>b[i]) then
              begin
               temp:=False;
               Break;
             end;
         end;
        if temp then
          begin
           Result:=true;
           zuiyouzhi:=temp_z;
           z:=0;
           for j:=1 to VarNum do
            z:=z+x[j]*c[j];//通过全局变量z传递最优值，注意这里的最优值不包含放缩值
         end;
      end;
  end;
end;
{----------算法的核心寻找最优值--------------------}

procedure TForm2.BitBtn1Click(Sender: TObject);
var i,j,k:Integer;
    num:Integer;//最优解的个数
    zl:real;
    hangzhi:real;
    temp:Boolean;
begin
bianhuanxishu;//调整目标函数系数全部为非负
meijucishu:=1;
for j:=1 to VarNum do
  meijucishu:=meijucishu*2;//计算枚举次数2的n次方次，n代表变量个数
if lookbest then
  begin
    num:=0;//初值为0
    for k:=meijucishu-1 downto 0 do
      begin
         zl:=0;
         bins:=IntToBin(k);
         for j:= 1 to VarNum do
           begin
             x[j]:=StrToInt(copy(bins,32-VarNum+j,1));
             zl:=zl+x[j]*c[j];
           end;
         if abs(zl-z)<0.000001 then //检验目标函数值是否是最优值
           begin
             temp:=true;
             for i:=1 to ConNum do//检验是否满足约束条件
               begin
               hangzhi:=0;
               for j:=1 to VarNum do
                 hangzhi:=hangzhi+a[i,j]*x[j];
               if (sign(hangzhi-b[i])<>opt[i]) and (hangzhi<>b[i]) then
                 begin
                  temp:=False;
                  Break;
                 end;
               end; //检验是否满足约束条件
             if  temp then
             begin
              //不能满足所有的约束条件，则跳出循环，进行下一个枚举的判断
             num:=num+1;
             StringGrid1.RowCount:=num+1;
             StringGrid1.Cells[0,StringGrid1.RowCount-1]:='最优解 '+IntToStr(num);
              //动态调整文本框的行数，来显示所有最优解
             for  j:=1 to VarNum do
               begin
                 if j in fuxishu then
                    x[j]:=1-x[j];
                 StringGrid1.Cells[j,StringGrid1.RowCount-1]:=FloatToStr(x[j]);                      //显示最优解
               end;
             end;
           end;// 对应if abs(zl-z)<0.000001 then
       end;//对应for k:=qidian to zhongdian do

    if leixing='Min' then
      zuiyouzhi:=-zuiyouzhi;//求最小化问题时目标函数为相反数
    Label1.Caption:='该0－1规划的'+leixing+'值为:';
    Label1.Caption:=Label1.Caption+FormatFloat('0.######',zuiyouzhi);
    Label1.Caption:=Label1.Caption+#13+'共有 '+IntToStr(num)+' 个最优解如下表所示';
    StringGrid1.SetFocus;
  end
else
  begin
     Label1.Caption:='该0－1规划无可行解';
    // FormActivate(Sender);
  end;
end;


procedure TForm2.BitBtn3Click(Sender: TObject);
begin
Form2.Close;
Form1.Close;
end;

procedure TForm2.BitBtn2Click(Sender: TObject);
begin
Form1.Show;
end;

procedure TForm2.FormActivate(Sender: TObject);
var i,j:Integer;
begin
Label1.Caption:='隐枚举法求解0－1整形规划';
StringGrid1.RowCount:=5;
StringGrid1.ColCount:=VarNum+1;
for j:=1 to VarNum do
  StringGrid1.Cells[j,0]:='x'+IntToStr(j);
//设置文本框
with StringGrid1 do
  begin
    for i:=1 to RowCount-1 do
      for j:=1 to ColCount-1 do
        cells[j,i]:='';
  end;
StringGrid1.SetFocus;
end;

end.