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;//變量數(shù)
    Connum:Integer;//約束條件數(shù)
    leixiing:string;//返回目標(biāo)函數(shù)類(lèi)型

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;
{-------------初始化自定義類(lèi)型的矩陣----------------}

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]);
  //讀取系數(shù)矩陣和操作符
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]);
  //讀取目標(biāo)函數(shù)系數(shù)
end;
{----------讀取文本框中的數(shù)據(jù)-----------------------}

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;//所增加的行數(shù)
      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;
{------------對(duì)偶變換--------------------------}

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;
{---------判斷目標(biāo)函數(shù)------------------------}

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;
{---------判斷目標(biāo)函數(shù)------------------------}

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;//避免浮點(diǎn)數(shù)運(yùn)算
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;
     //系數(shù)據(jù)陣，限定向量，檢驗(yàn)數(shù)，目標(biāo)函數(shù)值的變換
      end;
 end;
for i:=0 to m do
  if i=r then a[i,s]:=1
  else  a[i,s]:=0;//變換主元素列
Result:=a;
end;
{---------------對(duì)應(yīng)原理第六步，完成了迭代變換-----------------------}

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;
{----------對(duì)應(yīng)原理第四步，附加一行和一列的情況下選取主列-------}

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:='你沒(méi)有輸入人和數(shù)據(jù)';
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];
//注意極大化問(wèn)題的處理
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];//最小化問(wèn)題解為表格的值得相反數(shù)
        zuiyoujie:='該線性規(guī)劃的'+leixiing+'為：'
          +FormatFloat('0.######',temp[0,0])+#13+'最優(yōu)解為：';
        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 ); //最優(yōu)解
       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('無(wú)可行解 '); //無(wú)可行解
             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;
{---------算法核心，調(diào)用小的函數(shù)和過(guò)程完成計(jì)算---------------}

procedure TForm1.BitBtn1Click(Sender: TObject);
var  i,j:integer;
begin
try
  ConNum:=strtoint(edit1.text);
  VarNum:=strtoint(edit2.text);  {輸入變量個(gè)數(shù)和約束條件個(gè)數(shù)}
except
  on EMathError do
   begin
     showmessage('輸入有誤!'+#13+'請(qǐng)確定您輸入的是整數(shù)并且沒(méi)有空格');
  //糾錯(cuò)
     exit;
  end;
end;
  stringgrid2.ColCount:=VarNum+3;
  stringgrid2.RowCount:=ConNum+2;
  stringgrid2.Cells[0,0]:='約束\變量';
  stringgrid2.Cells[0,ConNum+1]:='目標(biāo)函數(shù)';
  //表格的列數(shù)=變量數(shù)+3；第一列用作標(biāo)簽，最后兩列為運(yùn)算符及常數(shù)項(xiàng) }
  for j:=1 to VarNum do
     stringgrid2.Cells[j,0]:='X'+inttostr(j);
  //表格外觀，第一行、第一列用作標(biāo)簽.第一行顯示變量名
  for i:=1 to ConNum do
      StringGrid2.Cells[0,i]:='約束 '+IntToStr(i);
  stringgrid2.Cells[VarNum+1,0]:=  '運(yùn)算符';
    //表格第一行倒數(shù)第二列，顯示約束條件中的運(yùn)算符
  stringgrid2.Cells[VarNum+2,0]:='b';
    //表格第一行最后一列，顯示約束條件的常數(shù)項(xiàng)b
  leixiing:=RadioGroup1.Items[RadioGroup1.Itemindex];
    //設(shè)置目標(biāo)函數(shù)類(lèi)型
  StringGrid2.SetFocus;
end;
{----------設(shè)置數(shù)據(jù)輸入界面-----------------------}

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
leixiing:=RadioGroup1.Items[RadioGroup1.Itemindex];
    //設(shè)置目標(biāo)函數(shù)類(lèi)型
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var temp:zengguangjuzhen;
    m,n:Integer;
    jie:Boolean;//判斷有無(wú)可行解
begin
chushihua(a);//初始化變量
duqushuju;//讀取輸入數(shù)據(jù)
chushihua(temp);//初始化臨時(shí)變量
m:=Connum;
n:=Varnum;//行數(shù)和列數(shù)的傳遞
temp:=xianxingguihua(a,m,n,jie);
//程序核心，調(diào)用對(duì)偶單純形法進(jìn)行計(jì)算 
end;



end.