Cod sursa(job #928860)

Utilizator Dddarius95Darius-Florentin Neatu Dddarius95 Data 26 martie 2013 18:57:30
Problema Cuplaj maxim in graf bipartit Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.79 kb
// Arhiva Educationala - Cuplaj Maxim in Graf Bipartit
 
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 : text;
    q : adresa;
 
function pairup(k : longint) : longint;
var
    q : adresa;
begin
 
pairup := 0;
if (u[k] = 1) then  exit;    //return 0
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;   //return 1
        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;   //return 1
        end;
    q := q^.adr;
    end;
 
pairup := 0;                 //return 0
end;
 
begin
assign  (f, 'cuplaj.in');
reset   (f);
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;
close   (f);
 
{ 70 pct
for i := 1 to n do
    if (l[i] = 0) then
        if (pairup(i) = 0) then
            begin
            fillchar(u, n*sizeof(byte), 0);
            inc(cuplaj, pairup(i));
            end
        else
            inc(cuplaj);
}
 
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);
 
assign  (f,  'cuplaj.out');
rewrite (f);
writeln (f, cuplaj);
for i := 1 to n do
    if (l[i] <> 0) then
        writeln (f, i, ' ',l[i]);
close   (f);
 
end.