Cod sursa(job #1888529)

Utilizator TirauStelianTirau Ioan Stelian TirauStelian Data 22 februarie 2017 10:26:25
Problema Flux maxim Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.32 kb
program flu;
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;
    bufin,bufout:array[1..1 shl 17] of byte;
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 {daca varful a[x,i] nu face parte deja dintr-un drum de crestere
                si mai exista loc tzava pe x,a[x,i]}
                    begin
                      if a[x,i]=n then ok:=true {daca am ajuns la scurgere am determinat un drum de crestere}
                                  else begin tata[a[x,i]]:=x;inc(u); cc[u]:=a[x,i];end;{altfel setez predecesorul lui a[x,i] si-l pun
                                  in coada}
                    end;
              end;
              inc(p);
         end;
      bfs:=ok;
   end;
begin
assign(input,'maxflow.in'); reset(input);
assign(output,'maxflow.out'); rewrite(output);
settextbuf(input,bufin); settextbuf(output,bufout);
readln(n,m);
for i:=1 to m do
   begin
     readln(x,y,z);
     c[x,y]:=z;
     inc(a[x,0]);{cresc numarul arcelor ce ies din nodul x}
     a[x,a[x,0]]:=y;{Arcul cu numarul de ordine a[x,0] ce iese din x intra in y}
     inc(a[y,0]);{cresc numarul de arce ce intra in nodul y}
     a[y,a[y,0]]:=x;{arcul cu numarul de ordine a[y,0] ce iese din y intra in 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.