Решение транспортной задачи 3 — страница 7

  • Просмотров 352
  • Скачиваний 5
  • Размер файла 108
    Кб

принятия решений / Пер. с англ. Под ред. член-корр. РАН И.И. Елисеевой. – М.: Аудит. ЮНИТИ, 1997. – 590 с. ПРИЛОЖЕНИЕ А Блок-схема реализованного алгоритма начало ввод исходных данных сбалансирована ли задача? нет балансировка задачи да нахождение начального базисного решения определение U и V для базисных переменных определение оценок для небазисных переменных полученное решение оптимально? да нет вывод результатов ввод в базис

максимальной небазисной переменной построение цикла вывод из базиса минимальной переменной помеченной знаком “ – “ конец Рис А.1 – Блок-схема реализованного алгоритма ПРИЛОЖЕНИЕ Б Листинг программы «Transport» unit intr; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, ExtCtrls, StdCtrls, Buttons, Db, DBTables; type TForm1 = class(TForm) tab1: TStringGrid; Panel1: TPanel; prdl: TEdit; spr: TEdit; spros: TStringGrid; predl: TStringGrid; Label1: TLabel; Label2: TLabel; Button2: TButton; Button3: TButton; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6:

TLabel; Label8: TLabel; Memo1: TMemo; Button1: TButton; BitBtn1: TBitBtn; Label7: TLabel; Label9: TLabel; Bevel1: TBevel; procedure BitBtn1Click(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); private { Private declarations } public function read_data(): bool; procedure balans(); procedure First_resh(); procedure find_uv(); procedure xnbmax(var max:real;var xi,yi:integer); procedure print_tabl(); end; var Form1: TForm1; implementation uses task, dec; {$R *.DFM} var c: array [1..100, 1..100] of real; ch: array [1..6] of char; spl, dmd: array [1..100] of real; u,v: array [1..100] of real; sspl,sdmd:real; cycle,x: array [1..100, 1..100] of string; xnb: array [1..100, 1..100] of real;

rw1,bn,ed,t,it,jt,it0,jt0,cl,rw:integer; way:string; ways: array [1..100] of string; procedure search(q:string); var i,j:integer; begin j:=jt; i:=it; if q='up' then for i:=1 to it-1 do if not(x[i,j]='------------') then begin way:='up'; it:=i; break;end; if q='right' then for j:=cl downto jt+1 do if not(x[i,j]='------------') then begin way:='right'; jt:=j; break;end; if q='down' then for i:=rw downto it+1 do if not(x[i,j]='------------') then begin way:='down'; it:=i; break;end; if q='left' then for j:=1 to jt-1 do if not(x[i,j]='------------') then begin way:='left'; jt:=j; break;end; end; procedure TForm1.BitBtn1Click(Sender: TObject); var z,ind,i,j: integer; ci,ri: byte; s: string; cd:integer; bl,bln: boolean; min,max,tmp,r:real; zikl:integer; uzli: array [1..100,1..2] of

integer; begin if(not read_data()) then exit; balans(); First_resh(); repeat find_uv(); it:=1; jt:=1; xnbmax(max,it,jt); it0:=it; jt0:=jt; if max<=0 then break; x[it,jt]:='X'; it:=-1; jt:=-1; for i:=1 to 4 do begin way:='non'; it:=it0;jt:=jt0; if(i=1) then search('up'); if(i=2) then search('down'); if(i=3) then search('left'); if(i=4) then search('right'); if(way='non') then continue; zikl:=1; ways[1]:='first'; uzli[1][1]:=it; uzli[1][2]:=jt; repeat it:=uzli[zikl][1]; jt:=uzli[zikl][2]; s:=way; if(ways[zikl]='first') then begin if((way='up')or(way='down')) then begin way:='none'; search('left'); end else begin way:='none'; search('up'); end; if(way='none') then begin ways[zikl]:='second'; way:=s; end else begin ways[zikl]:='second'; zikl:=zikl+1; uzli[zikl][1]:=it;

uzli[zikl][2]:=jt; ways[zikl]:='first'; end; end; if(ways[zikl]='second') then begin if((way='up')or(way='down')) then begin way:='none'; search('right'); end else begin way:='none'; search('down'); end; if(way='none') then ways[zikl]:='end' else begin ways[zikl]:='end'; zikl:=zikl+1; uzli[zikl][1]:=it; uzli[zikl][2]:=jt; ways[zikl]:='first'; end; end; if(ways[zikl]='end') then begin if((s='up')or(s='down')) then way:='right' else way:='down'; if(zikl=1) then break else zikl:=zikl-1; end; until (it=it0) and (jt=jt0); if((it=it0)and(jt=jt0)) then break; end; min:=32000; if(way='non') then min:=0 else for i:=1 to zikl-1 do if((i mod 2)=1) then begin tmp:=strtofloat(x[uzli[i][1],uzli[i][2]]); if(tmp<min) then min:=tmp; end; x[it0][jt0]:=floattostr(min); bln:=false;