Cod sursa(job #272518)

Utilizator luigiPacala luigi Data 7 martie 2009 12:17:34
Problema Flux maxim Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.4 kb
uses crt;
var f:text;
    b,c,m,n,cap,min,fluxmax:int64;
    i:integer;
    a:array[1..50,1..50] of int64;
    v,pre:array[1..50] of int64;
    ver:array[1..50] of boolean;
    ok:boolean;
procedure fluxm(x:integer);
var i,r,j:integer;
begin
r:=x;
fillchar(v,sizeof(v),0);
i:=1;
min:=maxlongint;
while r<>1 do
 begin
  if a[pre[r],r]<min then
   min:=a[pre[r],r];
  v[i]:=r;
  inc(i);
  r:=pre[r];
 end;
v[i]:=1;
for j:=2 to i do
begin
 a[v[j],v[j-1]]:=a[v[j],v[j-1]]-min;
 a[v[j-1],v[j]]:=a[v[j-1],v[j]]+min;
end;
fluxmax:=fluxmax+min;
end;

procedure parcurgere(x:integer);
var i:integer;
BEgin

 for i:=1 to n do
 begin
  if i<>n then
   BEGIN
    if a[x,i]>0 then
     if ver[i]=false then
     begin
      pre[i]:=x;
      ver[i]:=true;
      parcurgere(i);
     end;
   END
   else
   if (a[x,i]>0) and (ver[i]=false) then
   begin
   ver[i]:=true;
   pre[i]:=x;
   fluxm(n);
   ver[i]:=false;
   end;
  if i=n then
  ver[x]:=false;
 end;
ENd;

begin
clrscr;
assign(f,'maxflow.in');
reset(f);
readln(f,n,m);
for i:=1 to m do
 begin
  readln(f,b,c,cap);
  a[b,c]:=cap;
 end;
close(f);
ok:=true;
ver[1]:=true;
parcurgere(1);
assign(f,'maxfow.out');
rewrite(f);
write(f,fluxmax);
close(f);
end.