Cod sursa(job #1367680)

Utilizator ghepard99Alexandru Tudor ghepard99 Data 2 martie 2015 00:24:49
Problema Flux maxim Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.36 kb
program flux2;
CONST inf:integer=9999;
VAR
c,f:array[1..1000,1..1000] of integer;
t:array[1..1000] of integer;
s,d,n,m:integer;
g,gf:text;
Procedure citire;
VAR
  x,y,k,i:integer;
BEGIN
  readln(g,n,m);
  FOR i :=1 to m Do BEGIN
    readln(g,x,y,k);
    c[x,y]:=k;
  END;

END;

Function min(a,b:integer):integer;
BEGIN
 if a>b THEN
 min:=b
 else
 min:=a;

END;

Function BF(s,d:integer):boolean;
VAR
 p,u,i,k:integer;
 q:array[1..1000] of integer;

BEGIN
 BF:=false;
 FOR i := 1 to n DO BEGIN
   t[i]:=0;
 END;
  p:=1;
  u:=1;
  q[p]:=s;
  t[s]:=-1;
  WHILE p<=u DO BEGIN
   k:=q[p];
     FOR i := 1 to n DO BEGIN
       IF (t[i]=0) AND(c[k,i]>f[k,i])THEN BEGIN
         u:=u+1;
         q[u]:=i;
         t[i]:=k;
         IF i=d THEN BF:=true;

       END;

     END;
    p:=p+1;

  END;
END;

Function flux():integer;
VAR
i,r:integer;

BEGIN
  flux:=0;
  s:=1;
  d:=n;
  WHILE BF(s,d) DO BEGIN
    r:=inf;
    i:=d;
    WHILE i<>s DO BEGIN
     r:=min(r,c[t[i],i]-f[t[i],i]);
     i:=t[i];
    END;
    i:=d;
    WHILE i<>s DO BEGIN
     f[t[i],i]:=f[t[i],i]+r;
     f[i,t[i]]:=f[i,t[i]]-r;
     i:=t[i];
    END;
    flux:=flux+r;
  END;
END;
BEGIN
  ASSIGN(g,'maxflow.in');
  RESET(g);
  ASSIGN(gf,'maxflow.out');
  REWRITE(gf);
  citire;

  writeln(gf,flux);
  close(g);
  close(gf);
END.