Cod sursa(job #410356)

Utilizator hungntnktpHungntnktp hungntnktp Data 4 martie 2010 12:01:09
Problema Flux maxim Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.77 kb
{DINH QUANG DAT TIN 07-10}
{FLOW}
CONST
 TFI='maxflow.in';
 TFO='maxflow.out';
 MAX=2001;
 MAXM=10000;
 maxval=100000000;
TYPE
 arr1int=array[0..MAX] of longint;
 pnode = ^node;
 node = record
         v,id:longint;
         next:pnode;
        end;
VAR
 fi,fo:text;
 res,first,last,m,s,tt,n:longint;
 kex,ken:array[0..MAX] of pnode;
 f,a:array[0..MAXM] of longint;
 queue,delta,trace,pace:arr1int;

PROCEDURE       addx(u,v,id:longint);
var
 t:pnode;
begin
 new(t);
 t^.v:=v;
 t^.id:=id;
 t^.next:=kex[u];
 kex[u]:=t;
end;

PROCEDURE       addn(u,v,id:longint);
var
 t:pnode;
begin
 new(t);
 t^.v:=v;
 t^.id:=id;
 t^.next:=ken[u];
 ken[u]:=t;
end;

PROCEDURE       input;
var
 u,v,c,i:longint;
begin
 assign(fi,tfi);reset(fi);
  read(fi,n,m);
  s:=1;
  tt:=n;
  for i:= 1 to m do
   begin
    read(fi,u,v,c);
    addx(u,v,i);
    addn(v,u,i);
    a[i]:=c;
   end;
 close(fi);
end;

PROCEDURE       init;
begin
 fillchar(f,sizeof(f),0);
 res:=0;
end;

PROCEDURE       push(u:longint);
begin
 inc(last);
 queue[last]:=u;
end;

FUNCTION        pop:longint;
begin
 pop:=queue[first];
 inc(first);
end;

PROCEDURE       init_flow;
begin
 fillchar(trace,sizeof(trace),0);
 last:=0;
 first:=1;
 push(s);
 delta[s]:=maxval;
 trace[s]:=-1;
end;

FUNCTION        smin(x,y:longint):longint;
begin
 if x>y then exit(y);
 exit(x);
end;

FUNCTION        findpath:boolean;
var
 t:pnode;
 id,u,v:longint;
begin
 repeat
  u:=pop;
  t:=kex[u];
  while t<>nil do
   begin
    v:=t^.v;
    id:=t^.id;
    t:=t^.next;
    if (f[id]<a[id]) and (trace[v]=0) then
     begin
      delta[v]:=smin(delta[u],a[id]-f[id]);
      trace[v]:=u;
      pace[v]:=id;
      if v=tt then exit(true);
      push(v);
     end;
   end;
  t:=ken[u];
  while t<>nil do
   begin
    v:=t^.v;
    id:=t^.id;
    t:=t^.next;
    if (f[id]>0) and (trace[v]=0) then
     begin
      delta[v]:=smin(delta[u],f[id]);
      trace[v]:=-u;
      pace[v]:=id;
      if v=tt then exit(true);
      push(v);
     end;
   end;
 until first>last;
 exit(false);
end;

PROCEDURE       incflow;
var
 t:pnode;
 incval,u,v,id:longint;
begin
 incval:=delta[tt];
 v:=tt;
 repeat
  u:=trace[v];
  id:=pace[v];
  if u>0 then f[id]:=f[id]+incval
   else
    begin
     u:=-u;
     f[id]:=f[id]-incval;
    end;
  v:=u;
 until v=s;
end;

PROCEDURE       process;
var
 id,u:longint;
 t:pnode;
begin
 repeat
  init_flow;
  if findpath then incflow else break;
 until false;
 t:=kex[s];
 while t<>nil do
  begin
   id:=t^.id;
   t:=t^.next;
   res:=res+f[id];
  end;
end;

PROCEDURE       output;
begin
 assign(fo,tfo);rewrite(fo);
  writeln(fo,res);
 close(fo);
end;

BEGIN
 input;
 init;
 process;
 output;
END.