Cod sursa(job #1638029)

Utilizator DoubleNyNinicu Cristian DoubleNy Data 7 martie 2016 20:41:25
Problema Cuplaj maxim in graf bipartit Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.53 kb

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  (input, 'cuplaj.in');
reset   (input);
readln  (input, n, m, e);
for i := 1 to e do
    begin
    readln (input, x, y);
    new(q); q^.inf := y; q^.adr := v[x]; v[x] := q;
    end;
close   (input);

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  (output,  'cuplaj.out');
rewrite (output);
writeln (output, cuplaj);
for i := 1 to n do
    if (l[i] <> 0) then
        writeln (output, i, ' ',l[i]);
close   (output);

end.