# Максимальное паросочетание: реализация на 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
for i:=1 to r do begin
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