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('原線性規劃無可行解');
           BitBtn4.Enabled:=False;
           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.