Cod sursa(job #1369691)

Utilizator ghepard99Alexandru Tudor ghepard99 Data 3 martie 2015 10:40:12
Problema Flux maxim Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 1.24 kb
program fluxxxx;
const inf=10000;
var n,m,i,s,d,j,k:integer;
    g,a:text;
    c:array[1..100,1..100]of integer;
    f:array[1..100,1..100]of integer;
    t:array[1..100]of integer;
    flux:longint;
function min(a,b:integer):integer;
 begin
 if a<b then
  min:=a
 else
  min:=b;
 end;
function bf(s,d:integer):integer;
var p,u,i,k:integer;
    q:array[1..10000]of integer;
begin
for i:=1 to n do
 t[i]:=0;
bf:=0;
p:=1;
u:=1;
q[p]:=s;
t[s]:=-1;
while p<=u do begin
 k:=q[p];
 for i:=1 to n do
  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:=1;
  end;
 p:=p+1;
 end;
end;
procedure fl;
var i,r:integer;
begin
flux:=0;
while bf(s,d)=1 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);
readln(g,n,m);
for k:=1 to m do begin
 read(g,i,j);
 read(g,c[i,j]);
end;
for i:=1 to n do begin
 for j:=1 to n do
  write(c[i,j],' ');
 writeln;
end;
close(g);
s:=1;
d:=n;
fl;
assign(a,'maxflow.out');
rewrite(a);
write(a,flux);
close(a);
end.