Лабораторна робота № 3
Тема: Транспортні сітки.
Мета: ознайомитись з алгоритмом Форда-Фалкенсона для знаходження потоку найбільшої довжини.
Код програми:
program MAX_POTIK;
uses crt;
type
    adresa=^lanka;
     lanka=record
         p:byte;
         d:byte;
      zdat:byte;
     potik:byte;
      next:adresa;
           end;
   adresal=^elem;
      elem=record
         l:adresa;
      next:adresal;
           end;
{*****************}
function MINIM(a,b:byte):byte;
begin
  if (a>b) then
    MINIM:=b
           else
    MINIM:=a;
end;{MINIM}
{*****************}
procedure DODATY_V_SPYSOK(var adr1:adresa;l:lanka);
var adr:adresa;
begin
  if (adr1=nil) then
  begin
    adr1:=new(adresa);
    adr1^:=l;
    adr1^.next:=nil;
    exit;
  end;
  adr:=adr1;
  while (adr^.next<>nil) do
    adr:=adr^.next;
  adr^.next:=new(adresa);
  adr^.next^:=l;
  adr^.next^.next:=nil;
end;{DODATY_V_SPYSOK}
{*****************}
procedure DOD_L(var adr1:adresal;punkt:adresa);
var adr:adresal;
begin
  adr:=new(adresal);
  adr^.l:=punkt;
  adr^.next:=adr1;
  adr1:=adr;
end;{DOD_L}
{*****************}
procedure VYKYN_L(var adr1:adresal);
var adr:adresal;
begin
  if (adr1<>nil) then
  begin
    adr:=adr1^.next;
    dispose(adr1);
    adr1:=adr;
  end;
end;{VYKYN_L}
{*****************}
procedure STVOR_SPYSOK(var adr1:adresa;var maxn,maxzdat:byte);
var f:text;
    l:lanka;
    s:string;
begin
  l.potik:=0;
  maxn:=0;
  maxzdat:=0;
  clrscr;
  writeln('Vvedit'' imya fayla z informaciyeyu ( pravyl''noyu !!! ) :');
  readln(s);
  s:='D:\misha\'+s+'.txt';
  assign(f,s);
  reset(f);
  while (not(eof(f))) do
  begin
    readln(f,l.p,l.d,l.zdat);
    if (maxn<l.d) then
      maxn:=l.d;
    if (maxzdat<l.zdat) then
      maxzdat:=l.zdat;
    DODATY_V_SPYSOK(adr1,l);
  end;
  close(f);
end;{STVOR_SPYSOK}
{*****************}
function IS_IN_PROYDENI(proydeni:adresal;n:byte):boolean;
var adrl:adresal;
    bool:boolean;
begin
  bool:=false;
  adrl:=proydeni;
  while ((adrl<>nil) and (not bool)) do
  begin
    bool:=((n=adrl^.l^.p) or (n=adrl^.l^.d));
    adrl:=adrl^.next;
  end;
  IS_IN_PROYDENI:=bool;
end;{IS_IN_PROYDENI}
{*****************}
procedure SHLYAH(holova:adresa;
                 poch,kin:byte;
             var min:byte;
             var proydeni:adresal;
             var bool:boolean);
var  adr:adresa;
    min1:byte; {min povynno zminyuvatysya lyshe v razi
                uspishnoho prohodgennya}
begin
  if (poch=kin) then
    bool:=true
                else
    begin
      bool:=false;
      adr:=holova;
      while ((adr<>nil) and (not(bool))) do
      begin
      {1}
        if     ((adr^.p=poch)
           and (adr^.zdat>adr^.potik)
           and not (IS_IN_PROYDENI(proydeni,adr^.d))) then
        begin
          min1:=MINIM(min,adr^.zdat-adr^.potik);
          DOD_L(proydeni,adr);
          SHLYAH(holova,adr^.d,kin,min1,proydeni,bool);
          if (bool) then
          begin
            min:=min1;
            adr^.potik:=adr^.potik+min;
          end;
          VYKYN_L(proydeni);
        end;
      {2}
        if     ((adr^.d=poch)
           and (adr^.potik>0)
           and not (IS_IN_PROYDENI(proydeni,adr^.p))) then
        begin
          min1:=MINIM(min,adr^.potik);
          DOD_L(proydeni,adr);
          SHLYAH(holova,adr^.p,kin,min1,proydeni,bool);
          if (bool) then
          begin
            min:=min1;
            adr^.potik:=adr^.potik-min;
          end;
          VYKYN_L(proydeni);
        end;
        adr:=adr^.next;
      end;
    end;
end;{SHLYAH}
{*****************}
VAR
          adr1,adr:adresa;
  maxn,maxz,rezerv:byte;
          proydeni:adresal;
                 p:integer;
          bool:boolean;
BEGIN {HOLOVNA PROHRAMA}
  p:=0;
  bool:=true;
  proydeni:=nil;
  STVOR_SPYSOK(adr1,maxn,maxz);
  rezerv:=0;
  adr:=adr1;
  writeln('******************');
  writeln('   Informaciya:');
  while (adr<>nil) do
  begin
    writeln(' ',adr^.p,' ',adr^.d,' ',adr^.zdat);
    adr:=adr^.next;
  end;
  writeln;
  writeln('varshyna-kinec?  ',maxn);
  writeln(' maxzdat: ',maxz);
  while (bool) do
  begin
    p:=p+rezerv;
    rezerv:=maxz;
    SHLYAH(adr1,0{poch_vershuna},maxn,rezerv,proydeni,bool);
  end;
  writeln;
  writeln('Maxymal?nyj Potik: ',p);
  while (adr1^.next<>nil) do
  begin
    adr:=adr1;
    while (adr^.next^.next<>nil) do
      adr:=adr^.next;
    dispose(adr^.next);
    adr^.next:=nil;
  end;
  dispose(adr1);
  adr1:=nil;
  repeat
  until keypressed;
END.
Мал.1 Виконання програми.
Висновок: на даній лабораторній роботі я навчився знаходити максимальний потік в транспортній сітці, використовуючи алгоритм Форда-Фалкенсона.