Cod sursa(job #516049)

Utilizator zseeZabolai Zsolt zsee Data 22 decembrie 2010 23:46:07
Problema Cuplaj maxim in graf bipartit Scor 30
Compilator fpc Status done
Runda Arhiva educationala Marime 1.64 kb
program cuplajjjjjj;
type Pgraf = ^Tgraf;
 Tgraf = record
          b:integer;
          kov:Pgraf;
         end;
var be,ki:text;
 n,m,x,y,min,mini,i:integer;
 v:array[1..10000] of Pgraf;
 mark:array[1..10000] of integer;
 num:array[1..10000] of integer;

procedure add(a,b:integer);
var p:Pgraf;
begin
 new(p);
 p^.kov := v[a];
 p^.b := b;
 v[a] := p;
end;

function remove(a,b:integer):boolean;
var p,pb:Pgraf;
begin
 write('REMOVE ',a,',',b,' ... ');
 p:=v[a];
 remove:=false;
 if p=nil then exit;
 if p^.b=b then
  begin
   v[a]:=p^.kov;
   dispose(p);
   remove:=true;
  end
   else
  begin
   pb:=p;
   p:=p^.kov;
   while (p<>nil) and (p^.b<>b) do
    begin
     pb:=p;
     p:=p^.kov;
    end;
   if p<>nil then
    begin
     pb^.kov := p^.kov;
     dispose(p);
     remove:=true;
    end;
  end;
 writeln('OK');
end;

procedure findmin;
var i:integer;
begin
 min:=10001;
 mini:=0;
 for i:=1 to n do
  if (num[i]<min)and(num[i]<>0) then
   begin
    min:=num[i];
    mini:=i;
   end;
 writeln('FINDMIN: min=',min,' i=',mini);
end;


begin
 assign(be,'cuplaj.in');
 assign(ki,'cuplaj.out');
 reset(be);
 rewrite(ki);
 readln(be,n,x,m);
 n:=0;
 for i:=1 to m do
  begin
   readln(be,x,y);
   add(x,y);
   if x>n then n:=x;
   if y>n then n:=y;
   inc(num[x]);
  end;
 findmin;
 while mini <> 0 do
  begin
   mark[mini]:= v[mini]^.b;
   for i:=1 to n do
    if remove(i,mark[mini]) then dec(num[i]);
   findmin;
  end;
 x:=0;
 for i:=1 to n do
  if mark[i] <> 0 then inc(x);
 writeln(ki,x);
 for i:=1 to n do
  if mark[i] <> 0 then writeln(ki,i,' ',mark[i]);
 close(ki);
end.