Cod sursa(job #928924)

Utilizator Dddarius95Darius-Florentin Neatu Dddarius95 Data 26 martie 2013 19:23:07
Problema Cuplaj maxim in graf bipartit Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.46 kb
// Arhiva Educationala - Cuplaj Maxim in Graf Bipartit
//100p max 64ms pentru n,m<=10 000
type adresa=^nod;
     nod=record
     inf:integer;
     adr:adresa;
     end;

var n,m,x,y,cuplaj,change,i,e:longint;
    l,r:array[1..10020] of integer;
    u:array [1..10020] of byte;
    v:array[1..10020] of adresa;
    f,g:text;
    intrare,iesire:array[1..500000]of char;
    q:adresa;

function pairup(k:longint):longint;
var q:adresa;
begin
pairup:=0;
if (u[k]=1) then  exit;
u[k]:=1;
q := v[k];
while (q<>nil) do
    begin
    if (r[q^.inf]=0) then
        begin
        l[k]:=q^.inf;
        r[q^.inf]:=k;
        pairup:=1; exit;
        end;
    q:=q^.adr;
    end;
q := v[k];
while (q<>nil) do
    begin
    if (pairup(r[q^.inf])<>0) then
        begin
        l[k]:=q^.inf;
        r[q^.inf]:=k;
        pairup:=1; exit;
        end;
    q:=q^.adr;
    end;
pairup := 0;
end;

begin
assign(f,'cuplaj.in');reset(f);settextbuf(f,intrare);
assign(g,'cuplaj.out');rewrite(g);settextbuf(g,iesire);
readln(f,n,m,e);
for i := 1 to e do
    begin
    readln(f,x,y);
    new(q); q^.inf:=y; q^.adr:=v[x]; v[x]:=q;
    end;

repeat
change:=0;
fillchar(u,n*sizeof(byte),0);
for i:=1 to n do
    if (l[i]=0) then
        change:=change OR pairup(i);
until change=0;

for i:=1 to n do
    if (l[i]<>0) then inc (cuplaj);

writeln (g, cuplaj);
for i := 1 to n do
    if (l[i]<>0) then writeln (g, i, ' ',l[i]);
close(f);close(g);
end.