NKNET - Mạng truyền tin
Tác giả: ll931110
Ngôn ngữ: Pascal
program NKNET;
const
input = '';
output = '';
maxn = 100;
maxm = 10000;
maxv = 1000000;
var
a,c,f: array[1..maxn,1..maxn] of longint;
n,m: longint;
queue,trace: array[1..maxn] of longint;
front,rear: longint;
s,t: longint;
time: longint;
cc: longint;
lx,ly,t1,t2: array[1..maxm] of longint;
l1,l2: longint;
procedure init;
var
fi: text;
i,j,u,v: longint;
begin
assign(fi, input);
reset(fi);
read(fi, n, m);
fillchar(a, sizeof(a), 0);
for i := 1 to m do
begin
readln(fi, u, v, a[u,v]);
a[v,u] := a[u,v];
end;
readln(fi, s, t);
close(fi);
end;
function ok(x: longint): boolean;
var
u,v: longint;
begin
fillchar(trace, sizeof(trace), 0);
front := 1; rear := 1; queue[1] := s;
trace[s] := -1;
repeat
u := queue[front];
inc(front);
for v := 1 to n do
if (trace[v] = 0) and (a[u,v] > x) then
begin
trace[v] := u;
if v = t then exit(false);
inc(rear);
queue[rear] := v;
end;
until front > rear;
ok := true;
end;
procedure settime;
var
inf,sup,med: longint;
begin
inf := 0;
sup := maxn;
repeat
med := (inf + sup) div 2;
if ok(med) then
begin
time := med;
sup := med - 1;
end
else inf := med + 1;
until inf > sup;
end;
function FindPath: boolean;
var
u,v: longint;
begin
fillchar(trace, sizeof(trace), 0);
front := 1; rear := 1; queue[1] := s;
trace[s] := -1;
repeat
u := queue[front];
inc(front);
for v := 1 to n do
if (trace[v] = 0) and (c[u,v] > f[u,v]) then
begin
trace[v] := u;
if v = t then exit(true);
inc(rear); queue[rear] := v;
end;
until front > rear;
FindPath := false;
end;
procedure IncFlow;
var
d,u,v: longint;
begin
d := high(longint);
v := t;
repeat
u := trace[v];
if c[u,v] - f[u,v] < d then d := c[u,v] - f[u,v];
v := u;
until v = s;
v := t;
repeat
u := trace[v];
f[u,v] := f[u,v] + d;
f[v,u] := f[v,u] - d;
v := u;
until v = s;
end;
procedure FordFulkerson;
var
i,j,u,v: longint;
begin
fillchar(c, sizeof(c), 0);
for i := 1 to n do
for j := 1 to n do if a[i,j] > 0 then
begin
if a[i,j] <= time then c[i,j] := 1 else c[i,j] := maxv;
end;
fillchar(f, sizeof(f), 0);
repeat
if not FindPath then break;
IncFlow;
until false;
cc := 0;
l1 := 0; l2 := 0;
for i := 1 to n do
if trace[i] = 0 then
begin
inc(l2); t2[l2] := i;
end
else
begin
inc(l1); t1[l1] := i;
end;
for i := 1 to l1 do
for j := 1 to l2 do
begin
u := t1[i]; v := t2[j];
if (c[u,v] = 1) and (f[u,v] = 1) then
begin
inc(cc);
lx[cc] := u; ly[cc] := v;
end;
end;
end;
procedure printresult;
var
fo: text;
i: longint;
begin
assign(fo, output);
rewrite(fo);
writeln(fo, cc);
for i := 1 to cc do writeln(fo, lx[i], ' ', ly[i]);
close(fo);
end;
begin
init;
settime;
FordFulkerson;
printresult;
end.