MINCOST - Luồng với chi phí nhỏ nhất
Tác giả: ll931110
Ngôn ngữ: Pascal
program MINCOST;
const
input = '';
output = '';
maxn = 103;
var
d,c,f: array[1..maxn,1..maxn] of longint;
n,m,k,s,t,count: longint;
inqueue: array[1..maxn] of boolean;
queue: array[0..maxn] of longint;
best,trace: array[1..maxn] of longint;
front,rear: longint;
fi,fo: text;
procedure openfile;
begin
assign(fi, input); reset(fi);
assign(fo, output); rewrite(fo);
end;
procedure init;
var
i,u,v: longint;
begin
readln(fi, n, m, k, s, t);
fillchar(c, sizeof(c), 0);
fillchar(f, sizeof(f), 0);
for i := 1 to m do
begin
readln(fi, u, v, d[u,v], c[u,v]);
d[v,u] := d[u,v];
c[v,u] := c[u,v];
end;
end;
function FindPath: boolean;
var
u,v,tmp: longint;
nt: longint;
begin
fillchar(trace, sizeof(trace), 0);
for u := 1 to n do best[u] := high(longint);
best[s] := 0;
fillchar(inqueue, sizeof(inqueue), false);
inqueue[s] := true;
nt := 1;
front := 1; rear := 1; queue[1] := s;
repeat
u := queue[front];
front := (front + 1) mod maxn;
inqueue[u] := false;
dec(nt);
for v := 1 to n do if c[u,v] > f[u,v] then
begin
if f[u,v] = 0 then tmp := d[u,v] else tmp := d[u,v] * f[u,v] div abs(f[u,v]);
if best[v] > best[u] + tmp then
begin
best[v] := best[u] + tmp;
trace[v] := u;
if not inqueue[v] then
begin
inqueue[v] := true;
inc(nt);
rear := (rear + 1) mod maxn;
queue[rear] := v;
end;
end;
end;
until nt = 0;
FindPath := (best[t] < high(longint));
end;
procedure IncFlow;
var
u,v,p: longint;
delta: longint;
begin
delta := high(longint);
v := t;
while v <> s do
begin
u := trace[v];
if f[u,v] >= 0 then p := c[u,v] - f[u,v] else p := f[v,u];
if delta > p then delta := p;
v := u;
end;
if delta > k - count then delta := k - count;
count := count + delta;
v := t;
while v <> s do
begin
u := trace[v];
f[u,v] := f[u,v] + delta;
f[v,u] := f[v,u] - delta;
v := u;
end;
end;
procedure solve;
begin
count := 0;
repeat
if not FindPath then break;
IncFlow;
until count = k;
end;
procedure printresult;
var
i,j,cost: longint;
begin
if count < k then writeln(fo, -1) else
begin
cost := 0;
for i := 1 to n do
for j := 1 to n do
if f[i,j] > 0 then cost := cost + d[i,j] * f[i,j];
writeln(fo, cost);
for i := 1 to n do
for j := 1 to n do
if f[i,j] > 0 then writeln(fo, i, ' ', j, ' ', f[i,j]);
writeln(fo, 0, ' ', 0, ' ', 0);
end;
end;
procedure closefile;
begin
close(fo); close(fi);
end;
begin
openfile;
init;
solve;
printresult;
closefile;
end.