Cod sursa(job #426810)

Utilizator florin_marius90Florin Marius Popescu florin_marius90 Data 27 martie 2010 12:40:43
Problema Flux maxim Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.34 kb
var v:array[1..100000,1..100000] of longint;

tata:array[1..100000] of integer;

f,g:text;

nod,i,s,d,n,m:integer;

c,min,flux:longint;

ok:boolean;

procedure parcurgere;

var viz:array[1..100000] of boolean;

c:array[1..100000] of integer;

p,u:integer;

begin

fillchar(viz,sizeof(viz),false);

p:=1;

u:=1;

c[p]:=1;

while p<=u do

begin

nod:=c[p];

for i:=1 to n do

if (not viz[i]) and (v[nod,i]>0) then

begin

viz[i]:=true;

inc(u);

c[u]:=i;

tata[i]:=nod;

end;

inc(p);

end;

if viz[d] then ok:=true else ok:=false;

end;

 

procedure progra;

begin

parcurgere;

while ok do begin

for i:=1 to n do

if v[i,n]>0 then begin

min:=v[i,n];

nod:=i;

while nod<>s do

begin

if min>v[tata[nod],nod] then

min:=v[tata[nod],nod];

nod:=tata[nod];

end;

nod:=i;

while nod<>s do

begin

v[tata[nod],nod]:=v[tata[nod],nod]-min;

v[nod,tata[nod]]:=v[nod,tata[nod]]+min;

nod:=tata[nod];

end;

v[i,n]:=v[i,n]-min;

{v[n,i]:=v[n,i]+min;}

flux:=flux+min; end;

parcurgere;

end;

end;

 

begin

assign(f,'maxflow.in'); reset(f);

assign(g,'maxflow.out'); rewrite(g);

readln(f,n,m);   flux:=0;

for i:= 1 to m do

begin

readln(f,s,d,c);

v[s,d]:=c;

end;

s:=1; d:=n;

progra;

write(g,flux);

close(f); close(g);

end.