算法模板:匈牙利算法模板(二分图匹配)

 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.

 

你可能感兴趣的:(模板,匈牙利算法)