Cod sursa(job #1217538)

Utilizator RusuAlexeiRusu Alexei RusuAlexei Data 7 august 2014 17:37:04
Problema Cuplaj maxim in graf bipartit Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.82 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 pair(x:longint):byte;
  var q:lista;
  begin
    if vis[x]=1 then exit(0);
    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(1);
          end else
          begin
            if (pair(match[q^.info])=1) then
              begin
                match[q^.info]:=x;
                m2[x]:=q^.info;
                vis[x]:=0;
                exit(1);
              end;
          end;
        q:=q^.next;
      end;
    exit(0);
  end;

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

  readln(n,m,e);
  for i:=1 to e do
    begin
      readln(x,y);
      new(r);
      r^.info:=y;
      r^.next:=a[x];
      a[x]:=r;
    end;
  for i:=1 to n 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 n do
    begin
      if m2[i]=0 then
      if pair(i)=1 then inc(ans) else for y:=1 to n do vis[y]:=0;
    end;
  writeln(ans);
  for i:=1 to n do
    if m2[i]<>0 then writeln(i,' ',m2[i]);
  close(output);
end.