Cod sursa(job #557572)

Utilizator FLORINSTELISTUOprea Valeriu-Florin FLORINSTELISTU Data 16 martie 2011 18:30:47
Problema Flux maxim Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 2.05 kb
program flux;
type vect=array[0..100]of longint;
var c,f:array[0..100,0..100]of integer;
     fin,fout:text;n,m,s,d,i,rez,q,x,y,c1,p:longint;
     viz,v:vect;ok:boolean;
function bfs(n:longint):boolean;
var p,u,i,x:longint;q:vect;
begin
     q[0]:=s;
     p:=0;u:=p;
     viz[s]:=1;
        while (p<=u)and(viz[d]=0) do begin
         x:=q[p];
           for i:=1 to n do
            if viz[i]=0 then
             if f[x,i]<c[x,i] then begin
               viz[i]:=x;
               inc(u);
               q[u]:=i;
               end            else
             if f[i,x]>0 then begin
              viz[i]:=-x;
              inc(u);
              q[u]:=i;
              end;
             p:=p+1;
            end;
           if viz[d]=0 then bfs:=false
                       else bfs:=true;
         end;
function min(a,b:longint):longint;
begin
     if a<b then min:=a
            else min:=b;
            end;
begin
     assign(fin,'maxflow.in');reset(fin);
     assign(fout,'maxflow.out');rewrite(fout);
        readln(fin,n,m); s:=1;d:=n;
      for i:=0 to m-1 do begin
       readln(fin,x,y,c1);
        c[x,y]:=c1;
        end;
       ok:=false;
          repeat
          for i:=1 to n do viz[i]:=0;
         if not bfs(n) then begin
          ok:=true;
           break;
           end;
          v[0]:=d;
          p:=0;
            x:=10000;
            y:=x;
             while v[p]<>s do begin
              inc(p);
              v[p]:=abs(viz[v[p-1]]);
               if viz[v[p-1]]>0 then
               x:=min(x,c[v[p],v[p-1]]-f[v[p],v[p-1]])
                                 else
               if viz[v[p-1]]<0 then y:=min(y,f[v[p-1],v[p]]);
              end;
            q:=min(x,y);
              for i:=p downto 1 do
               if viz[v[i-1]]>0 then f[v[i],v[i-1]]:=f[v[i],v[i-1]]+q
                                else f[v[i-1],v[i]]:=f[v[i-1],v[i]]-q;

                 until ok;
          for i:=1 to n do rez:=rez+f[i,d];
         writeln(fout,rez);
       close(fin);close(fout);
     end.