题解。。。

var l:longint;p:array[0..5000]of longint;
dis:array[0..5000]of real;
name:array[0..5000]of string[20];
procedure init;
var ch:char;
begin
l:=0;
while not(eof) do
begin
inc(l);
readln(p[l],dis[l],ch,name[l]);
end;
end;
procedure qsort(l,r:longint);
var i,j:longint;s:string;z:longint;x,t:real;
begin
i:=l;j:=r;
x:=dis[(i+j) shr 1];
repeat
while dis[i]<x do inc(i);
while dis[j]>x do dec(j);
if i<=j then
begin
t:=dis[i];dis[i]:=dis[j];dis[j]:=t;
z:=p[i];p[i]:=p[j];p[j]:=z;
s:=name[i];name[i]:=name[j];name[j]:=s;
inc(i);dec(j);
end;
until i>j;
if l<j then qsort(l,j);
if i<r then qsort(i,r);
end;
procedure find;
var r,r1,r2,ap,t:real;j,i:longint;k1,k2:longint;
s:string;
begin
t:=(p[1]*dis[1]+p[2]*dis[2])/(p[1]+p[2]);
ap:=p[1]+p[2];
for i:=3 to l do
begin
t:=(ap*t+p[i]*dis[i])/(ap+p[i]);
ap:=ap+p[i];
end;
i:=1;
while (dis[i]<=t)and(i<=l) do inc(i);
k1:=i-1;k2:=i;
r:=1000000000000000000000;
for j:=1 to 500 do
begin
r1:=0;
r2:=0;
for i:=1 to l do
begin
r1:=r1+p[i]*abs(dis[i]-dis[k1]);
r2:=r2+p[i]*abs(dis[i]-dis[k2]);
end;
if r1<r then
begin
s:=name[k1];
r:=r1;
end;
if r2<r then
begin
s:=name[k2];
r:=r2;
end;
if k1>1 then dec(k1);
if k2<l then inc(k2);
end;
writeln(s);
end;
begin
init;
qsort(1,l);
find;
end.

3 条评论

  • 1

信息

ID
1225
难度
6
分类
高精度 | 其他 | 排序 点击显示
标签
(无)
递交数
1184
已通过
275
通过率
23%
被复制
5
上传者