Cod sursa(job #928889)

Utilizator Dddarius95Darius-Florentin Neatu Dddarius95 Data 26 martie 2013 19:12:46
Problema Cuplaj maxim in graf bipartit Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.76 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,g:text;
    intrare,iesire:array[1..300000]of char;
    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);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;


{ 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);

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