Cod sursa(job #20863)
Utilizator | Data | 22 februarie 2007 15:43:40 | |
---|---|---|---|
Problema | Amlei | Scor | 0 |
Compilator | fpc | Status | done |
Runda | Arhiva de probleme | Marime | 3.06 kb |
program flux;
var fin,g:text;
a,c,f:array[1..100,1..100] of longint;
n,min,i,j,s:longint;
pred:array[1..1000] of longint;
viz:array[1..1000] of boolean;
ok:boolean;
procedure iofile;
var i,j,cap:longint;
begin
assign(fin,'flux.in');
reset(fin);
assign(g,'flux.out');
rewrite(g);
readln(fin,n);
fillchar(c,sizeof(c),0);
fillchar(f,sizeof(f),0);
while not eof(fin) do
begin
readln(fin,i,j,cap);
c[i,j]:=cap;
end;
close(fin);
end;
procedure flux_rez;
var i,j:longint;
begin
for i:=1 to n do
for j:=1 to n do
begin
if (c[i,j]>f[i,j])or(c[i,j]=f[i,j])and(
c[i,j]<>0) then
a[i,j]:=c[i,j]-f[i,j] else
if f[j,i]>0 then
a[i,j]:=f[j,i];
end;
for i:=1 to n do
viz[i]:=false;
viz[1]:=true;
pred[1]:=0;
end;
procedure minim(n:longint);
begin
if n<>1 then
begin
if a[pred[n],n]<min then
min:=a[pred[n],n];
minim(pred[n]);
end;
end;
procedure crestere(n:longint);
begin
if n<>1 then
begin
f[pred[n],n]:=f[pred[n],n]+min;
crestere(pred[n]);
end;
end;
procedure graf_flux;
var p,u,i,k:longint;
co:array[1..10000] of longint;
begin
p:=1;
u:=1;
co[1]:=1;
ok:=true;
while (p<=u)and ok do
begin
k:=co[p];
for i:=1 to n do
if (a[k,i]>0)and (not viz[i]) then
begin
inc(u);
co[u]:=i;
pred[i]:=k;
viz[i]:=true;
if i=n then
ok:=false;
end;
inc(p);
end;
if not ok then
begin
min:=maxlongint;
minim(n);
crestere(n);
s:=s+min;
end;
end;
begin
iofile;
s:=0;
repeat
flux_rez;
graf_flux;
until ok;
writeln(g,s);
for i:=1 to n do
for j:=1 to n do
if f[i,j]>0 then
writeln(g,i,' ',j,' ',f[i,j]);
close(g);
end.