Cod sursa(job #302502)

Utilizator SprzlAbcdefg Sprzl Data 8 aprilie 2009 22:49:43
Problema Flux maxim Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.32 kb
program flux;
var nod,x,y,n,m,p,u,i:longint;
    min,c,fl:longint;
    a:array [1..1000,1..1000] of longint;
    viz:array [1..1000] of boolean;
    cd,pr:array [1..1000] of integer;
    ok:boolean;
procedure bf;
begin
  fillchar(viz,sizeof(viz),0);
  p:=1;u:=1;
  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;
        pr[i]:=cd[p];
      end;
    inc(p);
  end;

  ok:=viz[n];

end;

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

  readln(n,m);

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

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

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

        inc(fl,min);
        dec(a[i,n],min);
        inc(a[n,i],min);
      end;
    bf;
  end;

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