Cod sursa(job #557405)

Utilizator FLORINSTELISTUOprea Valeriu-Florin FLORINSTELISTU Data 16 martie 2011 17:25:11
Problema Cuplaj maxim in graf bipartit Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.18 kb
program cuplaj;
type nod=^graf;
       graf=record
         inf:longint;
         urm:nod;
         end;
var s,f,c:array[0..10000]of longint;
    v:array[0..10001]of nod;p:nod;
    i,j,x,y,n,k,m:longint; fin,fout:text;
procedure adauga(x,y:longint);
begin
     new(p);
     p^.inf:=y;
     p^.urm:=v[x];
     v[x]:=p;
       end;
function cauta(n:longint):integer;
var q:nod;
begin
      cauta:=0;
      if f[n]<>0 then
        cauta:=0
                 else begin
                 f[n]:=1;
                 new(q);
                 q:=v[n];
             while q<>nil do begin
               if c[q^.inf]=0 then begin
                 s[n]:=q^.inf;
                 c[q^.inf]:=n;
                 cauta:=1;
                 break;
                 end;
              q:=q^.urm;
             end;
                  new(q);
                  q:=v[n];
            while q<>nil do begin
             if cauta(c[q^.inf])<>0 then begin
               s[n]:=q^.inf;
               c[q^.inf]:=n;
               cauta:=1;
               break;
                end;
              q:=q^.urm;
             end;
         end;
      end;
function cuplaj(n:longint):integer;
var i:longint;
begin
      cuplaj:=0;
       for i:=1 to n do
        if s[i]=0 then begin
         if cauta(i)=0 then begin
          for j:=1 to n do f[j]:=0;
           cuplaj:=cuplaj+cauta(i);
            end
                        else inc(cuplaj);
          end;

        {  ok:=true;nr:=0;
         while ok do begin
           ok:=false;
          for i:=1 to n do f[i]:=0;
            for i:=1 to n do
              if s[i]=0 then
                  ok:=cauta(i);
             end;
             for i:=1 to n do
              if s[i]<>0 then inc(nr); }
             writeln(fout,cuplaj);
          for i:=1 to n do
            if s[i]<>0 then writeln(fout,i,' ',s[i]);
end;
begin
      assign(fin,'cuplaj.in');reset(fin);
      assign(fout,'cuplaj.out');rewrite(fout);
         readln(fin,n,m,k);
          for i:=k downto 1 do begin
           read(fin,x,y);
           adauga(x,y);
            end;
          cuplaj(n);
             close(fin);close(fout);
         end.