Cod sursa(job #280678)

Utilizator valytgjiu91stancu vlad valytgjiu91 Data 13 martie 2009 15:18:14
Problema Flux maxim Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.44 kb
const nmax=1000;
var h,g:text;
ct,f:array[1..nmax,1..nmax] of longint;
c,t:array[1..nmax]of longint;
viz:array[1..nmax]of 0..1;
flux,min,sursa,dest,k,x,y,i,m,j,n,z:longint;
ok:boolean;
function bf:boolean;
var pc,uc,x:longint;
var i:integer;
begin
 for i:=1 to n do
    viz[i]:=0;
 c[1]:=sursa;
 viz[1]:=1;
 pc:=1;
 uc:=1;
 while pc<=uc do
    begin
      x:=c[pc];
      for i:=1 to n do
        if (ct[x,i]-f[x,i]>0) and (viz[i]=0) then
           begin
             viz[i]:=1;
             uc:=uc+1;
             c[uc]:=i;
             t[i]:=x;
           end;
      pc:=pc+1;
    end;
 if viz[dest]=0 then bf:=false
          else bf:=true;
end;
begin
assign(h,'maxflow.in');
reset(h);
assign(g,'maxflow.out');
rewrite(g);
readln(h,n,m);
for i:=1 to m do
   begin
     readln(h,x,y,z);
     ct[x,y]:=z;
   end;
sursa:=1;
dest:=n;
while bf do
   for i:=1 to n do
     if ct[i,n]-f[i,n]>0 then
        begin
        min:=ct[i,n]-f[i,n];
        j:=i;
        while j<>sursa do
            begin
              if (min>(ct[t[j],j]-f[t[j],j]))then
                   min:=ct[t[j],j]-f[t[j],j];
              j:=t[j];
            end;
        j:=i;
        while j<>sursa do
           begin
           f[t[j],j]:=f[t[j],j]+min;
           f[j,t[j]]:=f[j,t[j]]-min;
           j:=t[j];
           end;
        f[i,n]:=f[i,n]+min;
        f[n,i]:=f[n,i]-min;
        flux:=flux+min;
      end;
close(g);
end.