Cod sursa(job #928858)

Utilizator Dddarius95Darius-Florentin Neatu Dddarius95 Data 26 martie 2013 18:57:14
Problema Cuplaj maxim in graf bipartit Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.77 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;
    chk:array[1..10000] of boolean;
    flc:array[1..10000] of integer;   //optimizez fillcharul
    nl, nr, m, i, x, y, t, flcn, j:longint;
    ok, change: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;
 
repeat
change:=false;
fillchar(chk, nl+1, false);
for i := 1 to nl do
  begin
  ok:=false;
//  for j := 1 to flcn do chk[flc[j]]:=false;       //fillchar optimizat
//  flcn:=0;
  if l[i]=0 then
    begin
    cauta(v[i], i);
    change:=change or ok;
    end;
//  if ok=true then inc(t);
  end;
until change=false;
 
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.