Cod sursa(job #299266)

Utilizator cheery_g1rlHaller Emanuela cheery_g1rl Data 6 aprilie 2009 17:44:06
Problema Flux maxim Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.75 kb
var a:array[1..1000,0..1000] of integer;
    c,f:array[1..1000,1..1000] of longint;
    tata:array[1..1000] of integer;
    n,m,i,x,y,z,fmin,flux,j:longint;
function bfs:boolean;
   var cc:array[1..1000] of integer;
       ok:boolean;
       p,u:longint;
   begin
     ok:=false;
     for i:=1 to n do tata[i]:=0;
     p:=1; u:=1;
     cc[u]:=1;
     while p<=u do
         begin
           x:=cc[p];
           for i:=1 to a[x,0] do
              begin
                if (tata[a[x,i]]=0)and(c[x,a[x,i]]>f[x,a[x,i]]) then
                    begin
                      if a[x,i]=n then ok:=true
                                  else begin tata[a[x,i]]:=x;inc(u); cc[u]:=a[x,i];end;
                    end;
              end;

              inc(p);
         end;
      bfs:=ok;
   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,z);
     c[x,y]:=z;
     inc(a[x,0]);
     a[x,a[x,0]]:=y;
     inc(a[y,0]);
     a[y,a[y,0]]:=x;
   end;
while bfs do
   begin
     for i:=1 to a[n,0] do
      if tata[a[n,i]]<>0 then
        begin
          x:=a[n,i];
          fmin:=c[x,n]-f[x,n];
          while x<>1 do
            begin
              if fmin>c[tata[x],x]-f[tata[x],x] then fmin:=c[tata[x],x]-f[tata[x],x];
              x:=tata[x];
            end;
          x:=a[n,i];
          f[x,n]:=f[x,n]+fmin;
          f[n,x]:=f[n,x]-fmin;
          while x<>1 do
            begin
              f[tata[x],x]:=f[tata[x],x]+fmin;
              f[x,tata[x]]:=f[x,tata[x]]-fmin;
              x:=tata[x];
            end;
          flux:=flux+fmin;
        end;
   end;
writeln(flux);
close(output);
close(input);
end.