pascal匈牙利算法模板
//匈牙利算法模板
var
i,j,n,m,so,x,y,ans,t:longint;
h:array[1..200]of longint;
p:array[1..400]of longint;
bz,gcl:array[0..400]of boolean;
g,la:array[1..20000]of longint;
procedure ad(x,y:longint);
begin
inc(so);
la[so]:=h[x];
g[so]:=y;
h[x]:=so;
end;
function gh(x:longint):boolean;
var
j:longint;
begin
j:=h[x];
gcl[x]:=true; //给当前点打上递归标记
while j<>0 do
begin
if (bz[g[j]]=false)and(g[j]-n<>p[x]) then //此点未匹配过
begin
bz[g[j]]:=true;
p[g[j]]:=x;
p[x]:=g[j]-n;
gcl[x]:=false; //更新两个点的匹配状况
exit(true);
end
else
begin
if (g[j]-n<>p[x])and(gcl[p[g[j]]]=false)and(gh(p[g[j]])) then //此点没被打上递归标记,且非当前匹配点,
//则查看是否可以通过改变别的点的选择来匹配该点
begin
p[g[j]]:=x;
p[x]:=g[j];
gcl[x]:=false;
exit(true); //更新两个点的匹配状况,并返回可以通过改变别的点的选择来匹配该点
end;
end;
j:=la[j];
end;
gh:=false; //所有的边都走过仍无法匹配,说明不可行
end;
begin
assign(input,'sf_hungarianmethod.in');reset(input);
assign(output,'sf_hungarianmethod.out');rewrite(output);
readln(n,m);
readln(t);
for i:=1 to t do
begin
readln(x,y);
ad(x,y+n);
end;
for i:=1 to n do
begin
if (bz[i]=false)and(h[i]<>0) then
begin
j:=h[i];
fillchar(gcl,sizeof(gcl),false);
gcl[i]:=true; //先将当前点打上递归标记
while j<>0 do
begin
if bz[g[j]]=false then //被匹配点无匹配
begin
bz[g[j]]:=true;
bz[i]:=true;
p[g[j]]:=i;
p[i]:=g[j]-n; //更新两个点的匹配状况
break;
end
else
begin
if gh(p[g[j]]) then //如果可以通过改变别的点的选择来匹配该点
begin
bz[i]:=true;
p[g[j]]:=i;
p[i]:=g[j]-n; //更新两个点的匹配状况
break;
end;
end;
j:=la[j];
end;
end;
end;
ans:=0;
for i:=1 to n do if bz[i]=true then inc(ans);
writeln(ans);
close(input);
close(output);
end.