FLOW1 - Giao lưu

Tác giả: ll931110

Ngôn ngữ: Pascal

{$MODE DELPHI}
program FLOW1;
const
  input  = '';
  output = '';
  maxn = 1200;
type
  PNode = ^TNode;
  TNode = record
    val: integer;
    link: PNode;
  end;
var
  n,m,s,t: integer;
  c,f: array[0..maxn,0..maxn] of integer;
  a: array[0..maxn] of PNode;
  trace,queue: array[0..maxn] of integer;

procedure add(u,v,cost: integer);
var
  P: PNode;
begin
  New(P);
  P^.val := v;
  P^.link := a[u];
  a[u] := P;
  c[u,v] := cost;

  New(P);
  P^.val := u;
  P^.link := a[v];
  a[v] := P;
end;

procedure init;
var
  fi: text;
  i,v: integer;
begin
  fillchar(c, sizeof(c), 0);
  fillchar(f, sizeof(f), 0);

  assign(fi,input);
    reset(fi);

  readln(fi, n, m);
  s := 0;
  t := 2 * (m + n) + 1;
  for i := 1 to n do
    begin
      add(s,i,1);
      add(n + 2 * m + i,t,1);
    end;

  for i := 1 to n do
    begin
      while not Eoln(fi) do
        begin
          read(fi, v);
          add(i, n + v,1);
        end;
      readln(fi);
    end;

  for i := 1 to m do add(n + i,n + m + i,1);
  for i := 1 to n do
    begin
      while not Eoln(fi) do
        begin
          read(fi, v);
          add(n + m + v,n + 2 * m + i,1);
        end;
      readln(fi);
    end;

  close(fi);
end;

function FindPath: boolean;
var
  u,v: integer;
  front,rear: integer;
  P: PNode;
begin
  fillchar(trace, sizeof(trace), 0);
  trace[0] := -1;

  front := 1;
  rear := 1;
  queue[1] := s;

  repeat
    u := queue[front];
    inc(front);

    P := a[u];
    while P <> nil do
      begin
        v := P^.val;
        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;
        P := P^.link;
      end;
  until front > rear;

  FindPath := false;
end;

procedure IncFlow;
var
  u,v,delta: integer;
begin
  v := t;
  delta := high(integer);
  repeat
    u := trace[v];
    if c[u,v] - f[u,v] < delta then delta := c[u,v] - f[u,v];
    v := u;
  until v = s;

  v := t;
  repeat
    u := trace[v];
    f[u,v] := f[u,v] + delta;
    f[v,u] := f[v,u] - delta;
    v := u;
  until v = s;
end;

procedure FordFulkerson;
begin
  repeat
    if not FindPath then break;
    IncFlow;
  until false;
end;

procedure printresult;
var
  fo: text;
  i,j,u,v: integer;
begin
  assign(fo, output);
    rewrite(fo);

  for i := 1 to m do
    begin
      u := 0;
      for j := 1 to n do
        if f[j,n + i] = 1 then
          begin
            u := j;
            break;
          end;

      v := 0;
      for j := 1 to n do
        if f[n + m + i,n + 2 * m + j] = 1 then
          begin
            v := j;
            break;
          end;

      writeln(fo, u, ' ', v);
    end;

  close(fo);
end;

begin
  init;
  FordFulkerson;
  printresult;
end.

Download