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.

Download