YL杯超级篮球赛 (Standard IO)

题意/Description:

        一年一度的高一YL杯超级篮球赛开赛了。当然，所谓超级，意思是参赛人数可能多余5人。小三对这项篮球非常感兴趣，所以一场都没有落下。每个中午都准时守侯在篮球场看比赛。经过一个星期的研究，小三终于对篮球的技战术找到了一丝丝感觉了。他发现打YL杯的每个班都有一套相似的进攻战术：

1 ：控球后卫带球到前场，找到一个最佳攻击点 ( x , y )

　　2 ：所有除控卫以外的队员都从各自的当前位置迅速向 ( x , y ) 移动

　　3 ：控球后卫根据场上情况组织进攻

　　这个战术对于一般情况是非常奏效的，但是每个队员毕竟不像小三一样每天精力过剩，每个队员都有一个疲劳指数W，显然对于每个队员的移动需要消耗一些能量。

　　假设一个队员从位置 (x1 , y1 ) 移动到 ( x , y )的能量消耗为 w * (ABS ( x - x1 ) +ABS ( y -y1 ) ), 这里ABS为绝对值函数。那么我们希望整个队伍一次进攻的能量消耗当然是越少越好。显然能量消耗的多少直接取决于控球后卫对于攻击点 ( x , y )的选择。

　　因为参赛人数众多，所以小三希望你能编写一个程序，即帮他找出某个时刻的最佳攻击点。

读入/Input：

        第一行：一个整数N，表示篮球队人数

　　第二行：一共N个整数，其中的第i个数Wi表示第i个队员的疲劳指数。

　　第3~N+2行：每一行两个整数X和Y，其中的第i+2行，表示第i个队员的当前位置的横坐标和纵坐标。

输出/Output：

　　一个实数。表示所有队员集合到最佳攻击位置的能量消耗总和，答案保留两位小数。

题解/solution：

        要做此题，必先学带权中位数。下面有简单的解释：

                当点在中间时，才能保证两边比较接近，才能得到最小值。所以当左边第一次大于右边，即左边第一次大于总和的一半，所得位置最优。

        了解后，这题就是一个模板。

代码/Code：

<strong>type
  arr=array [0..1000001] of longint;
var
  n,tot:longint;
  w,x,y,ww:arr;
procedure init;
var
  i:longint;
begin
  readln(n);
  for i:=1 to n do
    begin
      read(w[i]);
      tot:=tot+w[i];
    end;
  for i:=1 to n do
    readln(x[i],y[i]);
end;

procedure qsort(var a:arr; l,r:longint);
var
 i,j,m,t:longint;
begin
  i:=l; j:=r;
  m:=a[(l+r) div 2];
  repeat
    while a[i]<m do inc(i);
    while a[j]>m do dec(j);
    if i<=j then
      begin
        t:=a[i]; a[i]:=a[j]; a[j]:=t;
        t:=w[i]; w[i]:=w[j]; w[j]:=t;
        inc(i); dec(j);
    end;
  until i>j;
  if l<j then qsort(a,l,j);
  if i<r then qsort(a,i,r);
end;

function workx:real;
var
  xx,i:longint;
  sum:real;
begin
  sum:=0;
  for i:=1 to n do
    begin
      sum:=sum+w[i];
      if sum>tot/2 then
        begin
          xx:=x[i];
          break;
        end;
    end;
  workx:=0;
  for i:=1 to n do
    begin
      if x[i]=xx then continue;
      workx:=workx+abs(xx-x[i])*w[i];
    end;
end;

function worky:real;
var
  yy,i:longint;
  sum:real;
begin
  sum:=0;
  for i:=1 to n do
    begin
      sum:=sum+w[i];
      if sum>tot/2 then
        begin
          yy:=y[i];
          break;
        end;
    end;
  worky:=0;
  for i:=1 to n do
    begin
      if y[i]=yy then continue;
      worky:=worky+abs(yy-y[i])*w[i];
    end;
end;

procedure main;
var
  xx,yy:real;
begin
  ww:=w;
  qsort(x,1,n);
  xx:=workx;
  w:=ww;
  qsort(y,1,n);
  yy:=worky;
  writeln(xx+yy:0:2);
end;

begin
  init;
  main;
end.</strong>