Раздел «Алгоритмы».BipartiteMatchingPAS:

Максимальное паросочетание: реализация на Pascal

{
  edge (i,j) — матрица смежности
  Пусть она дана.
}

Const
  max = 100;

Var
  v: array[1..max] of boolean;
  goes: array[1..max] of integer;

function try (j: Integer): boolean;
var
  i: Integer;
begin
  if v[j] then begin
    try:= false;
    exit;
  end;
  v[j]:= true;
  for i:= 1 to n-1 do
    if edge (i, j) and ((goes[i] = 0) or try(goes[i])) then begin
      try:= true;
      goes[i]:= j;
      exit;
    end;
  try:= false;
end;

function maxpares: Integer;
var cnt: Integer;
begin
  fillchar ( goes, sizeof(goes), 0 );
  cnt := n;
  for j := 1 to m do begin
    fillchar ( v, sizeof(v), false );
    if try ( j ) then
      inc ( cnt );
  end;
  maxpares := cnt;
end

{ (C) Igor Kvasov }
const
  maxn = 2000;
var
  n,m,r,i,j,u,v,ans:longint;
  ne,use,was:array[1..maxn]of longint;
  e,p:array[1..maxn,1..maxn] of integer;
  ok,ok0:boolean;

procedure find(u:longint);
var
  i:longint;
begin
  if was[u]=1 then exit;
  if (u>n)and(use[u]=0) then begin
    use[u]:=1; ok:=true; exit;
  end;
  was[u]:=1;
  for i:=1 to ne[u] do if (u<=n)xor(p[u,e[u,i]]=1) then begin
    find(e[u,i]);
    if ok then begin
      p[u,e[u,i]]:=1-p[u,e[u,i]];
      p[e[u,i],u]:=1-p[e[u,i],u];
      use[u]:=1;
      exit;
    end;
  end;
end;

begin
  read(n,m,r);
  for i:=1 to r do begin
    read(u,v);
    inc(ne[u]); e[u,ne[u]]:=n+v;
    inc(ne[n+v]); e[n+v,ne[n+v]]:=u;
  end;
  for i:=1 to n do begin
    fillchar(was,sizeof(was[1])*(n+m),0);
    if use[i]=0 then begin ok:=false;find(i);end;
  end;
  for i:=1 to n do inc(ans,use[i]);
  writeln(ans);
  for i:=1 to n do if use[i]=1 then begin
    write(i,' ');
    for j:=1 to ne[i] do if p[i,e[i,j]]=1 then begin writeln(e[i,j]-n);break;end;
  end;
end.

-- IgorKvasov? - 28 Dec 2004

AlgorithmClasifyForm
Type: Код
Scope: Графы
Strategy:  
Complexity: Low