Cod sursa(job #1217533)

Utilizator RusuAlexeiRusu Alexei RusuAlexei Data 7 august 2014 17:29:09
Problema Cuplaj maxim in graf bipartit Scor 90
Compilator fpc Status done
Runda Arhiva educationala Marime 2.41 kb
program gindaci;
  type lista=^celula;
  celula=record
           info:longint;
           next:lista;
         end;
  var bufin:array[1..100000] of byte;
      n,m,e,i,x,y,ans,t,k,j:longint;
      a:array[1..10000] of lista;
      r:lista;
      vis:array[1..10000]of byte;
      lmatch,rmatch:array[1..10000]of longint;

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

function max(u,v:longint):longint;
  begin
    if u>v then max:=u else max:=v;
  end;

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 rmatch[q^.info]=0 then
          begin
            rmatch[q^.info]:=x;
            lmatch[x]:=q^.info;
            vis[x]:=0;
            exit(1);
          end else
          begin
            if pair(rmatch[q^.info])=1 then
              begin
                 rmatch[q^.info]:=x;
                 lmatch[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);

 { readln(t);}t:=1;
  for k:=1 to t do
    begin
      readln(n,m,e);
      for i:=1 to min(n,m) do
        begin
          a[i]:=nil;
          lmatch[i]:=0;
        end;
      for i:=1 to max(n,m) do rmatch[i]:=0;
      if n<m then
        begin
          for i:=1 to e do
            begin
              readln(x,y);
              new(r);
              r^.info:=y;
              r^.next:=a[x];
              a[x]:=r;
            end;
        end else
        begin
          for i:=1 to e do
            begin
              readln(y,x);
              new(r);
              r^.info:=y;
              r^.next:=a[x];
              a[x]:=r;
            end;
        end;


      ans:=0;
      for i:=1 to min(n,m) do
        begin
          if pair(i)=1 then inc(ans) else for j:=1 to min(n,m) do vis[j]:=0;
        end;
      writeln(ans);
      if n<m then
        begin
          for i:=1 to n do
            if lmatch[i]<>0 then writeln(i,' ',lmatch[i]);
        end else
        begin
          for i:=1 to n do
            if rmatch[i]<>0 then writeln(i,' ',rmatch[i]);
        end;
    end;
  close(output);
end.