很裸的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.