Cod sursa(job #1217549)

Utilizator RusuAlexeiRusu Alexei RusuAlexei Data 7 august 2014 18:16:05
Problema Cuplaj maxim in graf bipartit Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.27 kb
program cuplaj;
  type lista=^celula;
       celula=record
                info:longint;
                next:lista;
              end;
  var bufin,bufout:array[1..100000] of byte;
      a:array [1..10000] of lista;
      r:lista;
      n,m,e,i,x,y,ans:longint;
      match,m2:array[1..10000] of longint;
      vis:array[1..10000]of byte;

function min(u,v:longint):longint;
  begin
    if u<v then min:=u else min:=v;
  end;

function pair(x:longint):boolean;
  var q:lista;
  begin
    if vis[x]=1 then exit(false);
    vis[x]:=1;
    q:=a[x];
    while q<> nil do
      begin

        if (match[q^.info]=0)  then
          begin
            match[q^.info]:=x;
            m2[x]:=q^.info;
            vis[x]:=0;
            exit(true);
          end else
          begin
            if (pair(match[q^.info])) then
              begin
                match[q^.info]:=x;
                m2[x]:=q^.info;
                vis[x]:=0;
                exit(true);
              end;
          end;
        q:=q^.next;
      end;
    exit(false);
  end;

begin
  assign(input,'cuplaj.in');
  reset(input);
  settextbuf(input,bufin);
  assign(output,'cuplaj.out');
  rewrite(output);
  settextbuf(output,bufout);

  readln(n,m,e);
  if n<m then
  for i:=1 to e do
    begin
      readln(x,y);
      new(r);
      r^.info:=y;
      r^.next:=a[x];
      a[x]:=r;
    end else
  for i:=1 to e do
    begin
      readln(y,x);
      new(r);
      r^.info:=y;
      r^.next:=a[x];
      a[x]:=r;
    end;
  for i:=1 to min(n,m) do
    begin
      r:=a[i];
      while r<>nil do
        begin
          if match[r^.info]=0 then
            begin
              match[r^.info]:=i;
              m2[i]:=r^.info;
              inc(ans);
              break;
            end;
          r:=r^.next;
        end;
    end;
  for i:=1 to min(n,m) do
    begin
      if m2[i]=0 then
        begin

          if pair(i) then inc(ans){ else};
          for y:=1 to n do vis[y]:=0;
        end;
    end;
  writeln(ans);
  if n<m then
    begin
      for i:=1 to n do
        if m2[i]<>0 then writeln(i,' ',m2[i]);
    end else
    begin
      for i:=1 to n do
        if match[i]<>0 then writeln(i,' ',match[i]);
    end;
  close(output);
end.