Cod sursa(job #35892)

Utilizator AymdTrimbitas Viorel Stefan Aymd Data 22 martie 2007 17:46:02
Problema Adapost 2 Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.12 kb
var f,g:text;
    i,j,n,ss:longint;
    a,b:array[1..50000]of real;
    sp:array[1..4]of real;
    s,x,y,p:real;

function suma(c,d:real):real;
var su:real;
begin
su:=0;
for i:=1 to n do su:=su+sqrt((a[i]-c)*(a[i]-c)+(b[i]-d)*(b[i]-d));
suma:=su;
end;

begin
assign(f,'adapost2.in');
reset(f);
readln(f,n);
for i:=1 to n do begin
  readln(f,a[i],b[i]);
  x:=x+a[i];
  y:=y+a[i];
end;
x:=x/n;
y:=y/n;
p:=128;
s:=suma(x,y);
while p>0.00005 do begin
   sp[1]:=suma(x+p,y);
   sp[2]:=suma(x-p,y);
   sp[3]:=suma(x,y+p);
   sp[4]:=suma(x,y-p);
   ss:=1;
   for i:=2 to 4 do if sp[1]>sp[i] then begin
                                      sp[1]:=sp[i];
                                      ss:=i;
                                      end;
   if s>sp[1] then begin
                  s:=sp[1];
                  case ss of
                     1:x:=x+p;
                     2:x:=x-p;
                     3:y:=y+p;
                     4:y:=y-p;
                  end;
                  end
             else p:=p/2;
end;
assign(g,'adapost2.out');
rewrite(g);
write(g,x:0:4,' ',y:0:4);
close(g);
end.