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.