Cod sursa(job #1638140)

Utilizator DoubleNyNinicu Cristian DoubleNy Data 7 martie 2016 21:28:56
Problema Cuplaj maxim in graf bipartit Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.74 kb

type
    adresa=^nod;
    nod=record
           inf:integer;
           adr:adresa;
    end;

var
    n,m,x,y,cuplaj,change,i,e:longint;
    l,r:array [1..10020] of integer;
    u:array [1..10020] of byte;
    v:array[1..10020] of adresa;
    q:adresa;

function pairup(k:longint):longint;
var
    q:adresa;
begin
     pairup:=0;
     if (u[k]=1) then  exit;    //return 0
     u[k]:=1;
     q:=v[k];
     while (q<>nil) do
     begin
           if (r[q^.inf]=0) then
              begin
                  l[k]:=q^.inf;
                  r[q^.inf]:=k;
                  pairup:=1;
                  exit;   //return 1
              end;
            q:=q^.adr;
     end;
     q:=v[k];
     while (q<>nil) do
     begin
         if (pairup(r[q^.inf]) <> 0) then
         begin
             l[k]:=q^.inf;
             r[q^.inf]:=k;
             pairup:=1;
             exit;   //return 1
         end;
         q:=q^.adr;
     end;
     pairup:=0;                 //return 0
end;

begin
     assign(input,'cuplaj.in'); reset(input);
     assign(output,'cuplaj.out'); rewrite(output);
     fillchar(v,sizeof(v),0);
     cuplaj:=0;
     readln(input,n,m,e);
     for i:=1 to e do
     begin
         readln(input,x,y);
         new(q);
         q^.inf:=y;
         q^.adr:=v[x];
         v[x]:=q;
     end;

     repeat
          change:=0;
          fillchar(u, n*sizeof(byte), 0);
          for i:=1 to n do
          if (l[i]=0) then
          change:=change OR pairup(i);
     until change=0;

    for i:=1 to n do
        if (l[i] <> 0) then inc (cuplaj);

    writeln (output,cuplaj);
    for i:=1 to n do
      if (l[i] <> 0) then writeln(output,i,' ',l[i]);

   close(input);
   close(output);
end.