Cod sursa(job #287852)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 25 martie 2009 11:38:33
Problema Cuplaj maxim in graf bipartit Scor 70
Compilator fpc Status done
Runda Arhiva educationala Marime 1.81 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: integer;
    i, e : longint;
    l, r : array [1..10000] of integer;
    u : array [1..10000] of byte;
    v : array[1..10000] of adresa;
    f : text;
    q : adresa;

function pairup(k : integer) : integer;
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(integer), 0);
            inc(cuplaj, pairup(i));
            end
        else
            inc(cuplaj);
}

repeat
change := 0;
fillchar(u, n*sizeof(integer), 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.