Cod sursa(job #302431)

Utilizator SprzlAbcdefg Sprzl Data 8 aprilie 2009 21:32:43
Problema Flux maxim Scor 30
Compilator fpc Status done
Runda Arhiva educationala Marime 1.39 kb
program flux;
var x,y,nod,p,u,n,m,i:integer;
    min,c,fl:longint;
    a:array [1..1000,1..1000] of longint;
    parinte,cd:array [1..1000] of integer;
    viz:array [1..1000] of boolean;
    continua:boolean;
procedure bf;
begin
  p:=1;
  u:=1;
  fillchar(viz,sizeof(viz),0);
  cd[p]:=1;
  while p<=u do
  begin
    for i:=1 to n do
      if (not viz[i]) and (a[cd[p],i]>0) then
      begin
        viz[i]:=true;
        inc(u);
        cd[u]:=i;
        parinte[i]:=cd[p];
      end;
    inc(p);
  end;

  if viz[n] then
    continua:=true
  else
    continua:=false;

end;

begin
  assign(input,'maxflow.in');
  assign(output,'maxflow.out');
  reset(input);
  rewrite(output);


  readln(n,m);
  for i:=1 to m do
  begin
    readln(x,y,c);
    a[x,y]:=c;
  end;

  fl:=0;

  bf;
  while continua do
  begin
    for i:=1 to n do
      if a[i,n]>0 then
      begin
        min:=a[i,n];
        nod:=i;
        while nod<>1 do
        begin
          if min>a[parinte[nod],nod] then
            min:=a[parinte[nod],nod];
          nod:=parinte[nod];
        end;

        nod:=i;
        while nod<>1 do
        begin
          dec(a[parinte[nod],nod],min);
          inc(a[nod,parinte[nod]],min);
          nod:=parinte[nod];
        end;


        inc(fl,min);
      end;
      bf;
  end;

  writeln(fl);
  close(input);
  close(output);
end.