Cod sursa(job #278855)

Utilizator philipPhilip philip Data 12 martie 2009 16:02:47
Problema Flux maxim Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.44 kb
var fin,g:text;
    n,m,i,j,s,d,min,flux:longint;
    cap,f:array[1..1000,1..1000] of longint;
    viz:array[1..1000] of boolean;
    c,t:array[1..1000] of longint;

procedure citire;
  var z,x,y:longint;
  begin
    assign(fin,'maxflow.in');
    reset(fin);
    readln(fin,n,m);
    for i:=1 to m do begin
      readln(fin,x,y,z);
      cap[x,y]:=z;
    end;
    s:=1;
    d:=n;
    close(fin);
  end;

function bf:boolean;
  var p,u,k,i:longint;
  begin
    for i:=1 to n do viz[i]:=false;
    c[1]:=s;
    p:=1;
    u:=1;
    while p<=u do begin
      k:=c[p];
      for i:=1 to n do
        if not viz[i] and (cap[k,i]-f[k,i]>0) then begin
          inc(u);
          c[u]:=i;
          t[i]:=k;
          viz[i]:=true;
        end;
      inc(p);
    end;
    if viz[d] then bf:=true else bf:=false;
  end;

BEGIN
  citire;
  assign(g,'maxflow.out');
  rewrite(g);
  while bf do
    for i:=1 to n do
      if cap[i,n]-f[i,n]>0 then begin
        min:=cap[i,n]-f[i,n];
        j:=i;
        while j<>s do begin
          if cap[t[j],j]-f[t[j],j]<min then
            min:=cap[t[j],j]-f[t[j],j];
          j:=t[j];
        end;
        j:=i;
        while j<>1 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;
  writeln(g,flux);
  close(g);
END.