MATCH1 - Cặp ghép không trọng số

Tác giả: ll931110

Ngôn ngữ: Pascal

program MATCH1;
const
  input  = '';
  output = '';
  maxn = 1000;
var
  a: array[1..maxn,1..maxn] of boolean;
  mx,my: array[1..maxn] of integer;
  trace,queue: array[1..maxn] of integer;
  front,rear: integer;
  m,n: integer;

procedure init;
var
  f: text;
  i,u,v: integer;
begin
  fillchar(a, sizeof(a), false);
  assign(f, input);
    reset(f);

  readln(f, m, n);
  while not eof(f) do
    begin
      readln(f, u, v);
      a[u,v] := true;
    end;

  close(f);
end;

procedure push(x: integer);
begin
  inc(rear);
  queue[rear] := x;
end;

function FindPath: integer;
var
  i,j: integer;
begin
  fillchar(trace, sizeof(trace), 0);
  front := 1; rear := 0;
  for i := 1 to m do
    if mx[i] = 0 then push(i);

  while front <= rear do
    begin
      i := queue[front];
      inc(front);

      for j := 1 to n do
        if (trace[j] = 0) and a[i,j] and (mx[i] <> j) then
          begin
            trace[j] := i;
            if my[j] = 0 then exit(j);
            push(my[j]);
          end;
    end;

  FindPath := 0;
end;

procedure Enlarge(x: integer);
var
  y,z: integer;
begin
  repeat
    y := trace[x];
    z := mx[y];
    mx[y] := x;
    my[x] := y;
    x := z;
  until x = 0;
end;

procedure solve;
var
  fin: integer;
begin
  repeat
    fin := FindPath;
    if fin <> 0 then Enlarge(fin);
  until fin = 0;
end;

procedure printresult;
var
  f: text;
  i,c: integer;
begin
  c := 0;
  for i := 1 to m do
    if mx[i] <> 0 then inc(c);

  assign(f, output);
    rewrite(f);

    writeln(f, c);
    for i := 1 to m do
      if mx[i] <> 0 then writeln(f, i, ' ', mx[i]);
  close(f);
end;

begin
  init;
  solve;
  printresult;
end.

Download