GPMB - Giải phóng mặt bằng

Tác giả: RR

Ngôn ngữ: Pascal

//Wishing myself a happy lunar new year with a lot of accept solutions
//Written by Nguyen Thanh Trung
{$R+,Q+}
program GPMB;
const
  FINP='';
  FOUT='';
  MAXN=1600;
  esp=1e-6;
var
  n:longint;
  x,y:array[1..MAXN] of longint;
  d,s:array[1..MAXN] of longint;
  cos:array[1..MAXN] of real;
  kq:longint;
function kc(x1,y1,x2,y2:longint):real;
begin
  kc:=sqrt(sqr(x1-x2)+sqr(y1-y2));
end;
procedure inp;
var
  f:text;
  i:longint;
begin
  assign(f,FINP); reset(f);
  readln(f,n);
  for i:=1 to n do
    readln(f,x[i],y[i],s[i]);
  close(f);
end;
procedure ans;
var
  f:text;
begin
  assign(f,FOUT); rewrite(f);
  writeln(f,kq);
  close(f);
end;
function max(a,b:longint):longint;
begin
  if a>b then max:=a else max:=b;
end;
procedure swap(var a,b:longint);
var
  temp:longint;
begin
  temp:=a; a:=b; b:=temp;
end;
procedure swapr(var a,b:real);
var
  temp:real;
begin
  temp:=a; a:=b; b:=temp;
end;
procedure sort(l,r:longint);
var
  i,j:longint;
  key:real;
begin
  i:=l; j:=r; key:=cos[(l+r) div 2];
  repeat
    while cos[i]<key do inc(i);
    while cos[j]>key do dec(j);
    if i<=j then
      begin
        swap(d[i],d[j]);
        swapr(cos[i],cos[j]);
        inc(i); dec(j);
      end;
  until i>j;
  if i<r then sort(i,r);
  if l<j then sort(l,j);
end;
procedure find(i:longint);
var
  j,sl:longint;
  t:longint;
begin
  sl:=1; d[sl]:=s[i]*s[i]+5;
  for j:=1 to n do
    if (y[j]>=y[i]) and (j<>i) then
      begin
        inc(sl);
        cos[sl]:=(x[j]-x[i])/kc(x[i],y[i],x[j],y[j]);
        d[sl]:=s[j]*s[j]+5;
      end;
  if sl=1 then exit;
  sort(2,sl);
  t:=d[1]; cos[1]:=cos[2];
  for j:=2 to sl do
    if abs(cos[j]-cos[j-1])<esp then
      begin
        t:=t+d[j];
        if t>kq then kq:=t;
      end
    else
      begin
        t:=d[1]+d[j];
        if t>kq then kq:=t;
      end;
end;
procedure solve;
var
  i:longint;
begin
  kq:=0;
  for i:=1 to n do
    find(i);
end;
begin
  inp;
  solve;
  ans;
end.

Download