Cod sursa(job #557812)

Utilizator FLORINSTELISTUOprea Valeriu-Florin FLORINSTELISTU Data 16 martie 2011 21:26:17
Problema Cuplaj maxim in graf bipartit Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.77 kb
program cuplaj;
type nod=^graf;
     graf=record
       inf:longint;
       urm:nod;
        end;
var v:array[0..10001]of nod;p:nod;
    viz,r,l:array[0..10001]of longint;
    f,g:text;n,m,e,i,x,y,cuplat,c:longint;
procedure adauga(x,y:longint);
begin
      new(p);
      p^.inf:=y;
      p^.urm:=v[x];
      v[x]:=p;
      end;
function cauta(nodi:longint):byte;
var k:nod;
begin
       cauta:=0;
     if viz[nodi]=1 then cauta:=0
                   else begin
       viz[nodi]:=1;
        new(k);
         k:=v[nodi];
          while k<>nil do begin
           if cauta(r[k^.inf])<>0 then begin
            l[nodi]:=k^.inf;
            r[k^.inf]:=nodi;
            cauta:=1;
            end;
            k:=k^.urm;
            end;
          new(K);
           k:=v[nodi];
            while k<>nil do begin
             if r[k^.inf]=0 then begin
              l[nodi]:=k^.inf;
              r[k^.inf]:=nodi;
              cauta:=1;
              end;
              k:=k^.urm;
             end;
            end;
           end;
begin
     assign(f,'cuplaj.in');reset(f);
     assign(g,'cuplaj.out');rewrite(g);
        readln(f,n,m,e);
         for i:=1 to e do begin
          readln(f,x,y);
          adauga(x,y);
           end;
          cuplat:=1;
            while cuplat<>0 do begin
             for i:=1 to n do viz[i]:=0;
              cuplat:=0;
               for i:=1 to n do
                 if l[i]=0 then
                   if cauta(i)<>0 then begin
                    inc(c);
                    cuplat:=1;
                     end;
                      end;
                 writeln(g,c);
               for i:=1 to n do
                if l[i]<>0 then writeln(g,i,' ',l[i]);
             close(f);close(g);
          end.