KWAY - Trao đổi thông tin
Tác giả: ll931110
Ngôn ngữ: Pascal
program KWAY;
const
input = '';
output = '';
maxn = 102;
maxt = 1000000;
var
d,c,f: array[1..maxn,1..maxn] of longint;
free: array[1..maxn,1..maxn] of boolean;
trace,best: array[1..maxn] of longint;
list: array[1..maxn] of longint;
nl: longint;
n,m,k,s,t: longint;
count: longint;
fi,fo: text;
q: array[0..maxn] of longint;
inqueue: array[1..maxn] of boolean;
front,rear: longint;
procedure openfile;
begin
assign(fi, input); reset(fi);
assign(fo, output); rewrite(fo);
end;
procedure init;
var
u,v,i: longint;
begin
readln(fi, n, m, k, s, t);
fillchar(c, sizeof(c), 0);
fillchar(d, sizeof(d), 0);
fillchar(f, sizeof(f), 0);
for i := 1 to m do
begin
readln(fi, u, v, d[u,v]);
d[v,u] := d[u,v];
c[u,v] := 1; c[v,u] := 1;
end;
end;
function FindPath: boolean;
var
u,v: longint;
nt,tmp: longint;
begin
fillchar(trace, sizeof(trace), 0);
fillchar(inqueue, sizeof(inqueue), false);
for v := 1 to n do best[v] := maxt;
best[s] := 0;
front := 1; rear := 1; q[1] := s;
nt := 1;
repeat
u := q[front];
dec(nt);
inqueue[u] := false;
front := (front + 1) mod maxn;
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
trace[v] := u;
best[v] := best[u] + tmp;
if not inqueue[v] then
begin
inqueue[v] := true;
inc(nt);
rear := (rear + 1) mod maxn;
q[rear] := v;
end;
end;
end;
until nt = 0;
FindPath := best[t] < maxt;
end;
procedure IncFlow;
var
u,v: longint;
begin
v := t;
inc(count);
while v <> s do
begin
u := trace[v];
inc(f[u,v]);
dec(f[v,u]);
v := u;
end;
end;
procedure solve;
begin
count := 0;
repeat
if not FindPath then break;
IncFlow;
until count = k;
end;
procedure track(u: longint);
var
v: longint;
begin
inc(nl); list[nl] := u;
if u = t then exit;
for v := 1 to n do
if free[u,v] and (f[u,v] = 1) then
begin
free[u,v] := false;
track(v);
break;
end;
end;
procedure printresult;
var
i,j: longint;
cost: longint;
begin
if count < k then writeln(fo, -1) else
begin
fillchar(free, sizeof(free), true);
cost := 0;
for i := 1 to n do
for j := 1 to n do
if f[i,j] = 1 then cost := cost + d[i,j];
writeln(fo, cost);
for i := 1 to k do
begin
nl := 0;
track(s);
write(fo, nl, ' ');
for j := 1 to nl do write(fo, list[j], ' ');
writeln(fo);
end;
end;
end;
procedure closefile;
begin
close(fo);
close(fi);
end;
begin
openfile;
init;
solve;
printresult;
closefile;
end.