jiry_2's Blog

很裸的KM算法，但是数据极其恶心。调了我好几个月才A掉（一开始在VIJOS做，然后跳过，今天重新开始做），要注意的是后面输入的缘分值可能为0，所以要把不能射箭两个人之间连上-maxlongint的边，不能连0。还有就是坐标可能不是整数，应当用浮点型存储。

program p2539;
	type
		people=record
			na:string;
			xx,yy:extended;
		end;
    var
        x,y,aimy:array[1..100] of longint;
        vx,vy:array[1..100] of boolean;
        w:array[1..100,1..100] of longint;
		p:array[1..200] of people;
        n,m,i,j,k,a,b,c:longint;
		d:extended;
		ss,s:string;
    function max(k1,k2:extended):extended;
        begin
            if k1<k2 then exit(k2) else exit(k1);
        end;
    function min(k1,k2:extended):extended;
        begin
            if k1<k2 then exit(k1) else exit(k2);
        end;
    function find(k:longint):boolean;
        var
            i,j,kk:longint;
        begin
			if k=0 then exit(false);
            vx[k]:=true;
            for i:=1 to n do
                if (vy[i]=false) and (x[k]+y[i]=w[k,i]) then begin
                    vy[i]:=true; 
                    if (aimy[i]=0) or (find(aimy[i])) then begin
						aimy[i]:=k;
                        exit(true);
                    end;
                end;
			exit(false);
        end;
    begin
		readln(d);
        readln(n);
        for i:=1 to 2*n do begin
			readln(s);
			j:=1;
			while (s[j+1]<>' ') do 
				inc(j);
			val(copy(s,1,j),p[i].xx,a);
			j:=j+2;
			k:=1;
			while (s[j+k]<>' ') do 
				inc(k);
			val(copy(s,j,k),p[i].yy,a);
			p[i].na:=copy(s,j+k+1,length(s)-j-k);
			for j:=1 to length(p[i].na) do 
				p[i].na[j]:=upcase(p[i].na[j]);
		end;
		readln(s);
		for i:=1 to n do
			for j:=1 to n do
				w[i,j]:=1;
		while s<>'End' do begin
			i:=1;
			k:=1;
			while s[i+k]<>' ' do
				inc(k);
			ss:=copy(s,i,k);
			for j:=1 to length(ss) do
				ss[j]:=upcase(ss[j]);
			for a:=1 to 2*n do
				if ss=p[a].na then break;
			i:=i+k+1;
			k:=1;
			while s[i+k]<>' ' do
				inc(k);
			ss:=copy(s,i,k);
			for j:=1 to length(ss) do
				ss[j]:=upcase(ss[j]);
			for b:=1 to 2*n do
				if ss=p[b].na then break;
			val(copy(s,i+k+1,length(s)-i-k),c,j);
			if a>b then w[b,a-n]:=c
				else w[a,b-n]:=c;
			readln(s);
		end;
		for i:=1 to n do
			for j:=1 to n do begin
				if sqr(p[i].xx-p[j+n].xx)+sqr(p[i].yy-p[j+n].yy)>sqr(d) then begin
					w[i,j]:=-1000000000;
					continue;
				end;
				for k:=1 to n*2 do
					if (k<>i) and (k<>j+n) and ((p[i].xx-p[j+n].xx)*(p[i].yy-p[k].yy)=(p[i].yy-p[j+n].yy)*(p[i].xx-p[k].xx))then begin
						if (p[k].xx>max(p[i].xx,p[j+n].xx)) or (p[k].xx<min(p[i].xx,p[j+n].xx)) or (p[k].yy>max(p[i].yy,p[j+n].yy)) or (p[k].yy<min(p[i].yy,p[j+n].yy)) then
							continue;
						w[i,j]:=-1000000000;
						break;
					end;
			end;
		{for i:=1 to n do begin
			for j:=1 to n do
				write(w[i,j],' ');
			writeln;
		end;
}        fillchar(y,sizeof(y),0);
        fillchar(x,sizeof(x),0);
        for i:=1 to n do
            for j:=1 to n do
                x[i]:=trunc(max(x[i],w[i,j])); 
        fillchar(aimy,sizeof(aimy),0);
        for k:=1 to n do
            repeat
				{for i:=1 to n do
					write(aimy[i],' ');
				readln;}
				fillchar(vx,sizeof(vx),false);
                fillchar(vy,sizeof(vy),false);
                if find(k) then break;
                c:=1000000;
                for i:=1 to n do begin
                    if not vx[i] then continue;
                    for j:=1 to n do begin
                        if vy[j] then continue;
                        c:=trunc(min(c,x[i]+y[j]-w[i,j]));
                    end;
                end;
                for i:=1 to n do begin
                    if vx[i] then x[i]:=x[i]-c;
                    if vy[i] then y[i]:=y[i]+c;
                end;
            until false;
        a:=0;
        for i:=1 to n do
            a:=a+w[aimy[i],i];
        writeln(a);
        {for i:=1 to n do
            writeln(aimy[i],' ',w[aimy[i],i]);
        readln;
        readln;}
    end.