Cod sursa(job #1645833)

Utilizator LaviniutSuciu Lavinia-Florina Laviniut Data 10 martie 2016 13:59:47
Problema Flux maxim Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.46 kb
const inf=110001;
var c,f:array[1..1000,1..1000]of longint;
    a:array[1..1000,1..1000]of byte;
    t:array[1..5000]of integer;
    n,s,d,i,j:integer;
    flux:longint;
    g:text;

procedure citire;
var i,m,j,k:integer;
    x:longint;
    f:text;
begin
assign(f,'maxflow.in');reset(f);
readln(f,n,m);
for i:=1 to n do
  for j:=1 to n do
    if i<>j then
      c[i,j]:=inf;
for k:=1 to m do
 begin
  readln(f,i,j,x);
  a[i,j]:=1;
  c[i,j]:=x;
 end;
close(f);
end;

function bf(s,d:integer):boolean;
var i,p,u,k:integer;
    q:array[1..5000]of integer;
begin
for i:=1 to n do
  t[i]:=0;
bf:=false;
t[s]:=-1;
q[1]:=s;
p:=1;
u:=1;
while p<=u do
 begin
  k:=q[p];
  for i:=1 to n do
    if (a[k,i]=1)and(t[i]=0) then
     begin
      u:=u+1;
      q[u]:=i;
      t[i]:=k;
      if i=d then
        bf:=true;
     end;
  p:=p+1;
 end;
end;

function min(i,j:longint):longint;
begin
if i>j then
  min:=j
else
  min:=i;
end;

procedure fluxm;
var i:integer;
    cmin:longint;
begin
flux:=0;
while bf(s,d) do
 begin
  cmin:=min(cmin,c[t[i],i]-f[t[i],i]);
  i:=t[i];
 end;
i:=d;
while i<>s do
 begin
  inc(f[t[i],i],cmin);
  dec(f[i,t[i]],cmin);
  i:=t[i];
 end;
flux:=flux+cmin;
end;

begin
citire;
s:=1;
d:=n;
for i:=1 to n do
  for j:=1 to n do
    if c[i,j]>0 then
     begin
      f[i,j]:=0;
      f[j,i]:=c[i,j];
     end;
fluxm;
assign(g,'maxflow.out');rewrite(g);
write(g,flux);
close(g);
end.