Cod sursa(job #582498)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 15 aprilie 2011 14:07:07
Problema Cuplaj maxim in graf bipartit Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.67 kb
type muchie=^nod;
     nod=record n:longint; a:muchie; end;

var v:array[1..10000] of muchie;
    buf1, buf2:array[1 .. 1 shl 17] of char;
    l, r:array[1..10000] of longint;         //l[i] este corespondentul varfului i (varful i face parte din componenta stanga)
    chk:array[1..10000] of boolean;          //Pentru a se evita ciclul infinit
    nl, nr, m, i, x, y, t:longint;
    ok, change:boolean;
    p:muchie;
    f, g:text;

procedure cauta(a:muchie; b:longint);
var q:muchie;
  begin
  // Initial se cauta printre elementele din componenta dreapta pentru care
  // nu s-a gasit cuplaj inca
  q:=a;
  while (q<> nil) and (ok=false) do
    begin
    if chk[q^.n] = false then
      begin
      if r[q^.n]=0 then              //S-a gasit varf din componenta dreapta care nu este cuplat
        begin
        ok:=true;                    //ok-Important cand se merge inapoi din recursivitate. ok=true => s-a gasit alternativa de cuplaj
        l[b]:=q^.n; r[q^.n]:=b;      //Se face cuplajul
        end;
      end;
    q:=q^.a;
    end;

  //Daca astfel de elemente nu exista se mai face o cautare printre elementele care au fost deja cuplate
  q:=a;
  while (q<> nil) and (ok=false) do
    begin
    if chk[q^.n] = false then
      begin
      chk[q^.n]:=true;
      cauta(v[r[q^.n]], r[q^.n]);   //Se cauta alternativa de cuplaj pentru r[q^.n] adica pentru nodul deja cuplat de varful ce ne intereseaza
      if ok=true then
        begin                       //Alternativa se gaseste in prima parcurgere, iar daca s-a gasit
        r[q^.n]:=b; l[b]:=q^.n;     //se actualizeaza acum, la sfarsitul recurentei
        end;
      end;
    q:=q^.a;
    end;
  end;

begin
assign (f, 'cuplaj.in'); settextbuf (f, buf1); reset (f);
assign (g, 'cuplaj.out'); settextbuf (g, buf2); rewrite (g);

//Citirea
readln (f, nl, nr, m);
for i := 1 to m do
  begin
  readln (f, x, y);
  new(p); p^.n:=y; p^.a:=v[x]; v[x]:=p;
  end;

repeat                                  //Se repeta pana nu se mai fac modificari
change:=false;
fillchar(chk, nl+1, false);             //Initializam vectorul elementelor modificate. Astfel evitam ciclul infinit
for i := 1 to nl do                     //Ia toate elementele pentru care nu s-a gasit cuplaj
  begin
  ok:=false;
  if l[i]=0 then
    begin
    cauta(v[i], i);                     //Se cauta cuplaj
    change:=change or ok;               //Variabila change se schimba daca s-a gasit cuplaj
    end;
  end;
until change=false;

//Numara cuplajele si face afisarea
for i := 1 to nl do if l[i]<>0 then inc(t);
writeln (g, t);
for i := 1 to nl do if l[i]<>0 then writeln (g, i, ' ', l[i]);

close (f); close (g);
end.