Cod sursa(job #1410492)

Utilizator casianos1996Marc Casian Nicolae casianos1996 Data 31 martie 2015 08:36:42
Problema Flux maxim Scor 70
Compilator fpc Status done
Runda Arhiva educationala Marime 2.97 kb
program flux_brut;
var     f,g:text;
        t,maxf,min,pas,k,p,n,m,i,j,c,x,y,s,d:longint;
        a:array[1..1000,1..1000] of longint;
        fr:array[1..1000] of byte;
        frz,niv,cd,pred:array[1..1000] of integer;
        viz:array[1..1000] of boolean;
        v:array[1..5000] of integer;
        bufin,bufout:array[1..1 shl 17] of byte;

function bfs(nod:integer):boolean; inline;//true daca mai pot ajunge in destinatie
var       p,i,st,sf:longint;
begin
  fillchar(viz,sizeof(viz),false);
  st:=0; sf:=1; cd[1]:=nod; pred[nod]:=0; viz[nod]:=true; niv[nod]:=0;
  while st<sf do
    begin
      inc(st);
      for i:=1 to n do
        begin
          if a[cd[st],i]>0 then
            if viz[i]=false then
              begin
                inc(sf);
                cd[sf]:=i;
                viz[cd[sf]]:=true;
                pred[cd[sf]]:=cd[st];
                niv[cd[sf]]:=niv[cd[st]]+1;//nivelul nodului in care merg este nivelul de unde vin +1
              end;
        end;
    end;
  if viz[n]=true then  bfs:=true
  else bfs:=false;
end;

begin
  assign(f,'maxflow.in'); reset(f);
  assign(g,'maxflow.out'); rewrite(g);
  settextbuf(f,bufin);
  settextbuf(g,bufout);
  readln(f,n,m);
  maxf:=0;
  for i:=1 to m do
    begin
      readln(f,x,y,c);
      a[x,y]:=c;
    end;
  pas:=1;//cu pas marchez in viz, ca sa nu il mai actualizez la fiecare bfs
  while bfs(1) do //daca mai am drum de la sursa la destinatie
    begin
      fr[1]:=1; fr[n]:=1;
      for i:=2 to n-1 do
        fr[pred[i]]:=1;  //gasesc frunzele, adica nodurile care nu se gasesc printre predecesorii nodurilor 2..n-1
      k:=0;
      for i:=2 to n-1 do
        if (fr[i]=0) and (a[i,n]>0) then//gasesc frunzele din care pot ajunge la destinatie
          begin
            inc(k);
            frz[k]:=i;//in frz memorez frunzele din care pot ajunge la destinatie
          end;
      for t:=1 to k do//pentru toate frunzele din care pot ajunge la destinatie
        begin
          p:=frz[t];
          v[1]:=n;
          i:=1;
          min:=maxlongint;
          while p<>0 do//reconstruiesc drumul pentru frunza t
            begin //in v memorez ordinea inversa a nodurilor de la sursa la destinatie care trece prin frunza t
              inc(i);//in v pe pozitia 1 am tot timpul destinatia
              v[i]:=p;
              p:=pred[p];
            end;
          for j:=i downto 2 do //caut minimul de pe drumul care contine frunza t
            if a[v[j],v[j-1]]<min then min:=a[v[j],v[j-1]];
          for j:=i downto 2 do
            begin
              a[v[j],v[j-1]]:=a[v[j],v[j-1]]-min;//scad minimul de pe drumul care contine frunza t
              a[v[j-1],v[j]]:=a[v[j-1],v[j]]+min;//adun minimul in graful rezidual de pe drumul invers care contine frunza t
            end;
          maxf:=maxf+min;//adun minimul de pe drumul care contine frunza t la fluxul maxim
        end;
      inc(pas);
    end;
  writeln(g,maxf);
  close(f); close(g);
end.