Cod sursa(job #582443)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 15 aprilie 2011 13:08:29
Problema Cuplaj maxim in graf bipartit Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.61 kb
type muchie=^nod;
     nod=record n:integer; 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 integer;
    chk:array[1..10000] of boolean;
    flc:array[1..10000] of integer;   //optimizez fillcharul
    nl, nr, m, i, x, y, t, flcn, j:integer;
    ok:boolean;
    p:muchie;
    f, g:text;

procedure cauta(a:muchie; b:longint);
var q:muchie;
  begin
  q:=a;
  while (q<> nil) and (ok=false) do
    begin
    if chk[q^.n] = false then
      begin
      if r[q^.n]=0 then
        begin
        ok:=true;
        l[b]:=q^.n; r[q^.n]:=b;
        end;
      end;
    q:=q^.a;
    end;

  q:=a;
  while (q<> nil) and (ok=false) do
    begin
    if chk[q^.n] = false then
      begin
      chk[q^.n]:=true;
      inc(flcn); flc[flcn]:=q^.n;       //pentru optimizarea fillchar
      cauta(v[r[q^.n]], r[q^.n]);
      if ok=true then
        begin
        r[q^.n]:=b; l[b]:=q^.n;
        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);

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;

for i := 1 to nl do
  begin
  if l[i]=0 then
    begin
    ok:=false;
    for j := 1 to flcn do chk[flc[j]]:=false;       //fillchar optimizat
    flcn:=0;

    cauta(v[i], i);
    if ok=true then inc(t);
    end;
  end;

writeln (g, t);
for i := 1 to nl do if l[i]<>0 then writeln (g, i, ' ', l[i]);

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