Cod sursa(job #928877)

Utilizator Dddarius95Darius-Florentin Neatu Dddarius95 Data 26 martie 2013 19:07:11
Problema Cuplaj maxim in graf bipartit Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.75 kb
program gigel;
type muchie=^nod;
     nod=record
     n:longint; a:muchie;
     end;
var v:array[1..10000] of muchie;
    intrare,iesire: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,intrare); reset(f);
assign(g,'cuplaj.out'); settextbuf(g,iesire);  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.