Cod sursa(job #410349)

Utilizator hungntnktpHungntnktp hungntnktp Data 4 martie 2010 11:57:44
Problema Cuplaj maxim in graf bipartit Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.75 kb
{DINH QUANG DAT TIN 07-10}
{MATCH}
CONST
 TFI='cuplaj.in';
 TFO='cuplaj.out';
 MAX=10001;
TYPE
 arr1int=array[0..MAX] of longint;
 pnode = ^node;
 node = record
         v:longint;
         next:pnode;
        end;
VAR
 fi,fo:text;
 res,m,k,n,top:longint;
 free:array[0..MAX] of boolean;
 ke:array[0..MAX] of pnode;
 matchy,stack,trace:arr1int;
 find:boolean;

PROCEDURE       add(u,v:longint);
var
 t:pnode;
begin
 new(t);
 t^.v:=v;
 t^.next:=ke[u];
 ke[u]:=t;
end;

PROCEDURE       input;
var
 i,u,v:longint;
begin
 assign(fi,tfi);reset(fi);
  read(fi,m,n,k);
  for i:= 1 to k do
   begin
    read(fi,u,v);
    add(u,v);
   end;
 close(fi);
end;

PROCEDURE       init;
var
 i:longint;
begin
 top:=m;
 for i:= 1 to m do stack[i]:=i;
 fillchar(matchy,sizeof(matchy),0);
end;

PROCEDURE       dfs(u:longint);
var
 v:longint;
 t:pnode;
begin
 t:=ke[u];
 while t<>nil do
  begin
   v:=t^.v;
   t:=t^.next;
   if free[v] then
    begin
     free[v]:=false;
     if matchy[v]=0 then find:=true
      else dfs(matchy[v]);
     if find then
      begin
       matchy[v]:=u;
       exit;
      end;
    end;
  end;
end;

PROCEDURE       process;
var
 i:longint;
 stop:boolean;
begin
 repeat
  fillchar(free,sizeof(free),true);
  stop:=true;
  for i:= top downto 1 do
   begin
    find:=false;
    dfs(stack[i]);
    if find then
     begin
      stop:=false;
      stack[i]:=stack[top];
      dec(top);
     end;
   end;
 until stop;
 res:=m-top;
end;

PROCEDURE       output;
var
 i:longint;
begin
 assign(fo,tfo);rewrite(fo);
  writeln(fo,res);
  for i:= 1 to n do
   if matchy[i]<>0 then writeln(fo,matchy[i],' ',i);
 close(fo);
end;

BEGIN
 input;
 init;
 process;
 output;
END.