Cod sursa(job #379974)

Utilizator philipPhilip philip Data 4 ianuarie 2010 15:30:59
Problema Cuplaj maxim in graf bipartit Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 3.03 kb
type pnod=^nod;
     nod=record
       inf:integer;
       cap:shortint;
       flux:shortint;
       adr:pnod;
       t:pnod;
     end;

var n,m,e,i,x,y,min,flux,j,p,u,k:longint;
    f,cp:array[0..20001] of pnod;
    capp,ff:array[0..20001] of shortint;
    c,t:array[0..20001] of integer;
    viz:array[0..20001] of boolean;
    nou,p1,p2:pnod;
    bf:boolean;

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

  for i:=1 to n+m+1 do viz[i]:=false;
    c[1]:=0;
    p:=1;
    u:=1;
    p1:=nil;
    while p<=u do begin
      k:=c[p];
      p1:=f[k];
      while (p1<>nil) do begin
        i:=p1^.inf;
        if not viz[i] and (p1^.cap-p1^.flux>0) then begin
          inc(u);
          c[u]:=i;
          cp[u]:=p1;
          p1^.t:=cp[p];
          viz[i]:=true;
        end else p1^.t:=nil;
        p1:=p1^.adr;
      end;
      inc(p);
    end;
    if viz[n+m+1] then bf:=true else bf:=false;

  while bf do begin
    for i:=n+1 to n+m do
      if capp[i]-ff[i]>0 then begin
        j:=i;
        min:=1;
        p1:=f[i];
        while p1^.inf<>m+n+1 do p1:=p1^.adr;
        p2:=p1;
        while p1<>nil do begin
          if p1^.cap-p1^.flux<1 then
            min:=0;
            p1:=p1^.t;
        end;
        if (min<>0) and (p2^.t<>nil) then begin
          p1:=p2;
          ff[i]:=ff[i]-1;
          while p1<>nil do begin
            if p1^.t=nil then j:=0 else j:=p1^.t^.inf;
            p1^.flux:=p1^.flux+1;
            p2:=f[p1^.inf];
            while (p2<>nil) and (p2^.inf<>j) do p2:=p2^.adr;
            if p2=nil then begin
              new(nou);
              nou^.inf:=i;
              nou^.adr:=f[p1^.inf];
              nou^.flux:=-1;
              f[p1^.inf]:=nou;
            end else begin
              dec(p2^.flux);
            end;
            p1:=p1^.t;
          end;
          flux:=flux+1;
        end;
      end;


    for i:=1 to n+m+1 do viz[i]:=false;
    c[1]:=0;
    p:=1;
    u:=1;
    p1:=nil;
    while p<=u do begin
      k:=c[p];
      p1:=f[k];
      while (p1<>nil) do begin
        i:=p1^.inf;
        if not viz[i] and (p1^.cap-p1^.flux>0) then begin
          inc(u);
          c[u]:=i;
          cp[u]:=p1;
          p1^.t:=cp[p];
          viz[i]:=true;
        end else p1^.t:=nil;
        p1:=p1^.adr;
      end;
      inc(p);
    end;
    if viz[n+m+1] then bf:=true else bf:=false;
  end;
  writeln(flux);
  for i:=1 to n do begin
    p1:=f[i];
    while p1<>nil do begin
      if p1^.flux=1 then writeln(i,' ',p1^.inf-n);
      p1:=p1^.adr;
    end;
  end;
  close(input);
  close(output);
end.