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