Задача линейного программирования (симплекс-метод)

 

 

 

 

 

 

 

 

 

 

3.3.Листинг программы

 

unit Main;

interface

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  Menus, ImgList, Child, StdCtrls, ComCtrls, Buttons, ExtCtrls, ToolWin;

 

type

  TMainForm = class(TForm)

    ImageList1: TImageList;

    SaveDialog1: TSaveDialog;

    StatusBar1: TStatusBar;

    OpenDialog1: TOpenDialog;

    MainMenu1: TMainMenu;

    FileMenu: TMenuItem;

    New: TMenuItem;

    Open: TMenuItem;

    CloseChild: TMenuItem;

    N9: TMenuItem;

    Save: TMenuItem;

    SaveAs: TMenuItem;

    N10: TMenuItem;

    N11: TMenuItem;

    N1Name1: TMenuItem;

    N2Name1: TMenuItem;

    N3Name1: TMenuItem;

    N4Name1: TMenuItem;

    N12: TMenuItem;

    ExitP: TMenuItem;

    Edit: TMenuItem;

    N20: TMenuItem;

    N21: TMenuItem;

    N23: TMenuItem;

    ChangeFun: TMenuItem;

    AddLim: TMenuItem;

    DelLim: TMenuItem;

    N8: TMenuItem;

    N5: TMenuItem;

    N6: TMenuItem;

    N29: TMenuItem;

    N30: TMenuItem;

    N1: TMenuItem;

    N4: TMenuItem;

    N3: TMenuItem;

    N2: TMenuItem;

    procedure ExitPClick(Sender: TObject);

    procedure NewClick(Sender: TObject);

    procedure FileMenuClick(Sender: TObject);

    procedure CloseChildClick(Sender: TObject);

    procedure EditClick(Sender: TObject);

    procedure ChangeFunClick(Sender: TObject);

    procedure AddLimClick(Sender: TObject);

    procedure N2Click(Sender: TObject);

    procedure N5Click(Sender: TObject);

    procedure N4Click(Sender: TObject);

    procedure N6Click(Sender: TObject);

    procedure SaveAsClick(Sender: TObject);

    procedure OpenClick(Sender: TObject);

    procedure SaveClick(Sender: TObject);

    procedure DelLimClick(Sender: TObject);

    procedure N8Click(Sender: TObject);

    procedure N1Name1Click(Sender: TObject);

  private

    { Private declarations }

    procedure CreateChild(const Name: String);

  public

    { Public declarations }

 

  end;

 

var

  MainForm: TMainForm;

      ItemDel:integer;

implementation

 

uses Parameters, About;

 

{$R *.DFM}

 

procedure TMainForm.CreateChild(const Name: String);

var

  Child: TChildForm;

begin

  Child:=TChildForm.Create(Application);

  child.Caption:=Name;

end;

 

procedure TMainForm.ExitPClick(Sender: TObject);

begin

Close;

end;

 

procedure TMainForm.NewClick(Sender: TObject);

begin

  CreateChild('Çàäà÷à '+IntToStr(MDIChildCount+1));

end;

 

procedure TMainForm.FileMenuClick(Sender: TObject);

begin

if ActiveMDIChild<>nil then

  begin

  MainForm.CloseChild.Enabled:=true;

  MainForm.Save.Enabled:=true;

  MainForm.SaveAs.Enabled:=true;

  end

else

  begin

  MainForm.CloseChild.Enabled:=false;

  MainForm.Save.Enabled:=false;

  MainForm.SaveAs.Enabled:=false;

  end

end;

 

procedure TMainForm.CloseChildClick(Sender: TObject);

begin

if ActiveMDIChild<>nil then ActiveMDIChild.Close;

end;

 

procedure TMainForm.EditClick(Sender: TObject);

begin

if ActiveMDIChild<>nil then

  begin

  MainForm.ChangeFun.Enabled:=true;

  MainForm.AddLim.Enabled:=true;

  MainForm.DelLim.Enabled:=true;

  MainForm.N8.Enabled:=true;

  MainForm.N20.Enabled:=true;

  end

else

  begin

  MainForm.ChangeFun.Enabled:=false;

  MainForm.AddLim.Enabled:=false;

  MainForm.DelLim.Enabled:=false;

  MainForm.N8.Enabled:=false;

  MainForm.N20.Enabled:=false;

  end

end;

 

procedure TMainForm.ChangeFunClick(Sender: TObject);

begin

ParametersForm.PageControl1.ActivePageIndex:=0;

ParametersForm.ShowModal;

end;

 

procedure TMainForm.AddLimClick(Sender: TObject);

begin

ParametersForm.PageControl1.ActivePageIndex:=1;

ParametersForm.ShowModal;

end;

 

procedure TMainForm.N2Click(Sender: TObject);

begin

MainForm.Enabled:=False;

AboutForm.Visible:=true;

end;

 

procedure TMainForm.N5Click(Sender: TObject);

begin

if ActiveMDIChild<>nil then

  begin

  MainForm.N6.Enabled:=true;

  MainForm.N30.Enabled:=true

  end

else

  begin

  MainForm.N6.Enabled:=false;

  MainForm.N30.Enabled:=false;

  end

end;

 

 

procedure TMainForm.N4Click(Sender: TObject);

begin

  Application.HelpCommand(3, 0);

end;

 

//Ñèìïëåêñ-ìåòîä

procedure TMainForm.N6Click(Sender: TObject);

var

  SimplexTable,SimplexTableNew:array of array of extended;

  GoalFun:array of extended;

  ArtFun:array of extended;

  ExtrEstimation:extended;

  k,i,j,MoreCount,LessCount,EquallyCount,extrItem,WLine,IterCount: integer;

  Art,bil:boolean;

label fin,up;

begin

Art:=true;bil:=false;IterCount:=0;

SimplexTable:=nil;

MoreCount:=0;LessCount:=0;EquallyCount:=0;

{1}//Ñîðòèðîâêà îãðàíè÷åíèé: 1) >=; 2) =; 3) <=.

{2}//Ïîðîæäåíèå íà÷àëüíîãî áàçèñà

{3}//Èòåðàöèîííîå ïîñòðîåíèå ñèìïëåêñ-òàáëèö

 

{1}//---------------------------------------------------------------------------

//Ñîðòèðîâêà "Áîëüøå"

with MainForm.ActiveMDIChild as TChildForm do

  begin

  //ñòðîêè â òàáëèöàõ äî÷åðíåãî  îêíà íóìåðóþòñÿ ñ 1

  //íóëåâàÿ ñòðîêà ðåçåðâíàÿ

  for i:=1 to SignsChild.RowCount-1 do

    begin

    if (SignsChild.Cells[0,i]='>') or (SignsChild.Cells[0,i]='>=') then

      begin

      inc(MoreCount);

      SetLength(SimplexTable,LimChild.ColCount+2,MoreCount);

      //êîýôôèöèåíòû

      for j:=0 to LimChild.ColCount-1 do

      SimplexTable[j+2,MoreCount-1]:=StrToFloat(LimChild.cells[j,i]);

      //Ïîêà íóëè (ïîòîì áàçèñ...)

      SimplexTable[0,MoreCount-1]:=0;

      //Çíà÷åíèå  (B i-ûé)

      SimplexTable[1,MoreCount-1]:=StrToFloat(BChild.cells[0,i]);

      end;

    end;

 

//Ñîðòèðîâêà "Ðàâíî"

  for i:=1 to SignsChild.RowCount-1 do

    begin

    if SignsChild.Cells[0,i]='=' then

      begin

      inc(EquallyCount);

      SetLength(SimplexTable,LimChild.ColCount+2,MoreCount+EquallyCount);

      //êîýôôèöèåíòû

      for j:=0 to LimChild.ColCount-1 do

      SimplexTable[j+2,MoreCount+EquallyCount-1]:=StrToFloat(LimChild.cells[j,i]);

      //Ïîêà íóëè (ïîòîì  áàçèñ...)

      SimplexTable[0,MoreCount+EquallyCount-1]:=0;

      //Çíà÷åíèå  (B i-ûé)

      SimplexTable[1,MoreCount+EquallyCount-1]:=StrToFloat(BChild.cells[0,i]);

      end;

    end;

 

//Ñîðòèðîâêà "Ìåíüøå"

  for i:=1 to SignsChild.RowCount-1 do

    begin

    if (SignsChild.Cells[0,i]='<') or (SignsChild.Cells[0,i]='<=') then

      begin

      inc(LessCount);

      SetLength(SimplexTable,LimChild.ColCount+2,MoreCount+EquallyCount+LessCount);

      //êîýôôèöèåíòû

      for j:=0 to LimChild.ColCount-1 do

      SimplexTable[j+2,MoreCount+EquallyCount+LessCount-1]:=StrToFloat(LimChild.cells[j,i]);

      //Ïîêà íóëè (ïîòîì  áàçèñ...)

      SimplexTable[0,MoreCount+EquallyCount+LessCount-1]:=0;

      //Çíà÷åíèå  (B i-ûé)

      SimplexTable[1,MoreCount+EquallyCount+LessCount-1]:=StrToFloat(BChild.cells[0,i]);

      end;

    end;

  end;

{2}//---------------------------------------------------------------------------

 

//Ïîðîæäåíèå íà÷àëüíîãî áàçèñà

//2.1 Äîáàâèòü êîýô. -1 (>=)

for j:=0 to MoreCount-1 do

  begin

  Setlength(SimplexTable,length(SimplexTable)+1,MoreCount+EquallyCount+LessCount);

  for i:=length(SimplexTable)-MoreCount+1 to length(SimplexTable)-1 do

  SimplexTable[i,j]:=0;

  SimplexTable[length(SimplexTable)-1,j]:=-1;

  end;

 

//2.2 Äîáàâèòü êîýô. 1 (<=)

for j:=MoreCount+EquallyCount to MoreCount+EquallyCount+LessCount-1 do

  begin

  Setlength(SimplexTable,length(SimplexTable)+1,MoreCount+EquallyCount+LessCount);

  for i:=length(SimplexTable)-LessCount+2 to length(SimplexTable)-1 do

  SimplexTable[i,j]:=0;

  SimplexTable[length(SimplexTable)-1,j]:=1;

  end;

 

//2.3 Äîáàâèòü èñêóññòâåííûå êîýô. (>= è =)

for j:=0 to MoreCount+EquallyCount-1 do

  begin

    Setlength(SimplexTable,length(SimplexTable)+1,MoreCount+EquallyCount+LessCount);

    for i:=length(SimplexTable)-MoreCount+1 to length(SimplexTable)-1 do

    SimplexTable[i,j]:=0;

    SimplexTable[length(SimplexTable)-1,j]:=1;

  end;

 

//Öåëåâàÿ ôóíêöèÿ GoalFun

GoalFun:=nil;

with MainForm.ActiveMDIChild as TChildForm do

  begin

  SetLength(GoalFun,GoalChild.ColCount+1);

  for i:=1 to GoalChild.ColCount do

    begin

    if parametersForm.Min.Checked then GoalFun[i]:=StrToFloat(goalChild.Cells[i-1,1])

    else GoalFun[i]:=-1*StrToFloat(goalChild.Cells[i-1,1]);

    end;

  end;

//Èñêóññòâåííàÿ ôóíêöèÿ ArtFun

ArtFun:=nil;

SetLength(ArtFun,length(SimplexTable)-1-MoreCount);

//i=1 - Çíà÷åíèå èñê. ôóíêöèè

for i:=1 to length(SimplexTable)-3 do

for j:=0 to MoreCount-1 do ArtFun[i-1]:=ArtFun[i-1]-SimplexTable[i,j];

 

//------------------------------------------------------------------------------

//Ìèíèìèçàöèÿ èñêóññòâåííîé ôóíêöèè

//Áàçèñ

if MoreCount>0 then

  begin

  for j:=0 to MoreCount-1 do

  SimplexTable[0,j]:=length(simplexTable)-MoreCount+j-1;

  for i:=MoreCount to length(simplexTable[0])-1 do

  SimplexTable[0,i]:=length(simplexTable)-(LessCount+EquallyCount+MoreCount)+(i-MoreCount)-1;

  end

else

for i:=0 to LessCount+EquallyCount-1 do

  SimplexTable[0,i]:=length(simplexTable)-(LessCount+EquallyCount+MoreCount)+i-1;

 

//2 íèæíèå ñòðîêè äëÿ îöåíîê

SetLength(SimplexTable,length(SimplexTable),length(SimplexTable[0])+2);

for i:=0 to length(GoalFun)-1 do SimplexTable[i+1,length(SimplexTable[0])-2]:=goalFun[i];

for i:=0 to length(ArtFun)-1 do SimplexTable[i+1,length(SimplexTable[0])-1]:=ArtFun[i];

 

SimplexTableNew:=nil;

SetLength(SimplexTableNew,length(SimplexTable),length(SimplexTable[0]));

//èòåðàöèè...

up:

repeat

if not art then inc(IterCount);

if IterCount=Parametersform.CountIteration.Value then

  begin

  with MainForm.ActiveMDIChild as TChildForm do

  begin

  task.Items.Add('');

  task.Items.Add('Äîñòèãíóòî ïðåäåëüíîå ÷èñëî èòåðàöèé. Ðåøåíèå íå íàéäåíî');

  exit;

  end;

  end;

 

//Ìîæåò ôóíêöèÿ íå îãðàíè÷åíà? => ïîèñê ñòîëáöà ñ îòðèöàòåëüíûìè  êîýô.

k:=0;

if art then

for i:=2 to length(simplexTable)-1 do

  begin

    if simplexTable[i,length(SimplexTable[0])-1]<0 then

      begin

  //    k:=0;

      for j:=0 to length(SimplexTable[0])-3 do

      if simplexTable[i,j]<=0 then inc(k);

      if k=length(SimplexTable[0])-2 then

        begin

        with MainForm.ActiveMDIChild as TChildForm do

          begin

          task.Items.Add('');

          task.Items.Add('Íåâîçìîæíî íàéòè íà÷àëüíûé áàçèñ');

          exit;

          end;

       k:=0;

       end;

      end;

   end;

k:=0;

if not art then

for i:=2 to length(simplexTable)-1 do

  begin

    if simplexTable[i,length(SimplexTable[0])-1]<0 then

      begin

      k:=0;

      for j:=0 to length(SimplexTable[0])-2 do

      if simplexTable[i,j]<=0 then inc(k);

      if k=length(SimplexTable[0])-1 then

        begin

        with MainForm.ActiveMDIChild as TChildForm do

          begin

          task.Items.Add('');

          task.Items.Add('Öåëåâàÿ ôóíêöèÿ íå îãðàíè÷åíà');

          exit;

          end;

        end;

      end;

   end;

 

 

//ïîèñê ïåðâîé ìèíèìàëüíîé èç  îòðèöàòåëüíûõ îöåíêè èñêóñòâåííîé  ôóíêöèè

ExtrEstimation:=100000;

extrItem:=0;

for i:=2 to length(simplexTable)-1 do

if (SimplexTable[i,length(SimplexTable[0])-1]<ExtrEstimation) and (SimplexTable[i,length(SimplexTable[0])-1]<0) then

begin

extrItem:=i-1;{íîâûé áàçèñ}

ExtrEstimation:=SimplexTable[i,length(SimplexTable[0])-1];

end;

if ExtrEstimation=100000 then goto fin;

 

 

//âûáîð ðàáî÷åé ñòðîêè (ïîèñê  ìèíèìàëüíîãî èç ïîëîæèòåëüíûõ)

ExtrEstimation:=100000;

WLine:=0;

for j:=0 to length(simplexTable[0])-2 do

begin

if SimplexTable[extrItem+1,j]<>0 then

if (SimplexTable[1,j]/SimplexTable[extrItem+1,j]<ExtrEstimation) and (SimplexTable[1,j]*SimplexTable[extrItem+1,j]>0) then

  begin

  WLine:=j;

  ExtrEstimation:=SimplexTable[1,j]/SimplexTable[extrItem+1,j];

  end;

end;

//íîâûé áàçèñ

for i:=0 to length(SimplexTable[0])-1 do SimplexTableNew[0,i]:=SimplexTable[0,i];

SimplexTableNew[0,WLine]:=extrItem;

//ïåðåðàñ÷åò ðàáî÷åé ñòðîêè

for i:=1 to length(SimplexTable)-1 do SimplexTableNew[i,WLine]:=SimplexTable[I,wlINE]/SimplexTable[extrItem+1,wlINE];

//ïåðåðàñ÷åò êîýôôèöèåíòîâ

for i:=1 to length(SimplexTable)-1 do

for j:=0 to length(SimplexTable[0])-1 do

if j<>WLine then

SimplexTableNew[i,j]:=SimplexTable[i,j]-SimplexTable[i,Wline]*SimplexTable[extrItem+1,j]/SimplexTable[extrItem+1,WLine];

//êîïèðîâàíèå òàáëèö

for i:=0 to length(SimplexTable)-1 do for j:=0 to length(SimplexTable[0])-1 do SimplexTable[i,j]:=SimplexTableNew[i,j];

//Âûâîä òåêóùåãî ðåøåíèÿ

if ParametersForm.CheckBox1.Checked then begin

bil:=false;

if not art then

with MainForm.ActiveMDIChild as TChildForm do

  begin

<