Решение транспортной задачи

 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 

      ПРИЛОЖЕНИЕ  А

Блок-схема  реализованного алгоритма  

 
 

 

 

 

 

 
 
 

 

 

 

 
 

      Рис А.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;

if(way<>'non') then

for i:=1 to zikl-1 do begin

  tmp:=strtofloat(x[uzli[i][1],uzli[i][2]]);

  if((i mod 2)=0) then begin tmp:=tmp+min; cycle[uzli[i][1],uzli[i][2]]:='+'; end

                  else begin tmp:=tmp-min; cycle[uzli[i][1],uzli[i][2]]:='-'; end;

  x[uzli[i][1],uzli[i][2]]:=floattostr(tmp); 

  if(((i mod 2)=1)and(tmp=0)and(not bln)) then begin

        x[uzli[i][1],uzli[i][2]]:='------------';

        bln:=true;

                                               end

                       end;

until false; 

form3.Visible:=true;

print_tabl(); 

for i:=1 to rw1 do begin

s:=inttostr(i)+'-ая  фабрика поставила товар в  '; tmp:=0;

 for j:=1 to cl do

   if not (x[i,j]='------------') then begin s:=s+inttostr(j)+'-й '; tmp:=tmp+1;

                                       r:=r+strtofloat(x[i,j])*c[i,j];

                                       end;

if tmp>1 then s:=s+'склады ' else s:=s+'склад ';

s:=s+'  ('+inttostr(i)+'-й маршрут).';

form1.Memo1.Lines.Append(s);

                  end; 
 

tmp:=0;

if rw1<rw then begin

for j:=1 to cl do if not (x[rw,j]='------------')

                      then tmp:=tmp+strtofloat(x[rw,j]);

form1.Memo1.Lines.Append('Не доставлено '+floattostr(tmp)+' партий товара.');

              end;

s:='Расходы составят '+floattostr(r)+' у.е.';

form1.Memo1.Lines.Append(s);

form1.Memo1.Lines.Append('--------------------------------------------------------------------------');

end; 

procedure TForm1.Button3Click(Sender: TObject);

 var i,j:integer;

s:string;

begin

if (form1.prdl.text='')or(form1.spr.text='') then begin beep;

    MessageDLG('Проверьте правильность введенных данных!', mtError, [mbOK], 0);

                                              exit;end;

val(form1.prdl.text,cl,t);

val(form1.spr.text,rw,t);

if (cl>7)or(rw>7) then begin beep;

    MessageDLG('Нельзя вводить такую большую размерность!', mtError, [mbOK], 0);

                   exit;end;

form1.spros.colcount:=cl;

form1.predl.rowcount:=rw; 

form1.bitbtn1.Enabled:=true;

label3.Enabled:=true;

label4.Enabled:=true;

label5.Enabled:=true;

label6.Enabled:=true;

label8.Enabled:=true;

Button2.Enabled:=true;

form1.predl.Enabled:=true;

form1.spros.Enabled:=true;

form1.tab1.Enabled:=true;

form1.Memo1.Enabled:=true;

// Очистка таблиц