Cod sursa(job #553488)

Utilizator boti12botiGal Botond boti12boti Data 14 martie 2011 09:17:01
Problema Flux maxim Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 1.64 kb
type
     rec=record
     a,b:longint; end;
     mat=array[1..1000,1..1000] of rec;
     vek=array[1..5000] of longint;
     vak=array[1..5000] of boolean;
var x:mat; f:text; i,n,m,a1,b1,c,max,min,w,s,j:longint; cs,os,v:vek; jr:vak;  t:boolean;
procedure df(k:longint);
  var i:longint;
  begin
    if k<n then begin
    for i:=1 to n do
      if ((x[k,i].a-x[k,i].b>0)or(x[i,k].b<>0))and(not jr[i]) then begin
      t:=true; inc(c); cs[c]:=i; jr[i]:=true; os[i]:=k; jr[i]:=true; end;
     j:=j+1;
      if cs[j]<>0 then df(cs[j]);
    end;  end;
begin
  assign(f,'maxflow.in');
  reset(f);
  readln(f,n,m);
  for i:=1 to m do begin
    readln(f,a1,b1,c);
    x[a1,b1].a:=c;
    end;
  close(f);
  max:=0;
  {for i:=1 to n do
   max:=max+x[i,n];    }
  c:=1;
  repeat
  for i:=1 to c do
   cs[i]:=0;
  for i:=1 to n do
    os[i]:=0;
  for i:=1 to n do
  jr[i]:=false;
  t:=false;
  c:=1; cs[c]:=1;
  jr[1]:=true;
  j:=1;
  df(1);
  if t and (cs[c]=n) then begin
  t:=true;
  i:=n;
  w:=1;
  v[w]:=i;
  repeat
  i:=os[i];
    inc(w); v[w]:=i;
  until i=1;
  min:=111111;
  for i:=w downto 2 do
  if x[v[i],v[i-1]].a<>0 then begin if x[v[i],v[i-1]].a-x[v[i],v[i-1]].b<min then min:=x[v[i],v[i-1]].a-x[v[i],v[i-1]].b;  end
  else begin if x[v[i-1],v[i]].b<min then min:=x[v[i-1],v[i]].b; end;
  for i:=w downto 2 do
   if x[v[i],v[i-1]].a<>0 then x[v[i],v[i-1]].b:=x[v[i],v[i-1]].b+min
   else x[v[i-1],v[i]].b:=x[v[i-1],v[i]].b-min;
    end
    else t:=false;
  until not t;
  s:=0;
  for i:=1 to n do
    s:=s+x[i,n].b;
  max:=s;
  assign(f,'maxflow.out');
  rewrite(f);
  writeln(f,max);
  close(f);
end.