ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Обсуждение задачи 1103. Карандаши и окружности

Why I get WA? Pelase, help me!!!!!!! (+)
Послано Nazarov Denis (nsc2001@rambler.ru) 18 фев 2002 22:49
Program t1103;{$N+}

Const Eps     = 1E-10;
      MaxN    = 5000;

Var   C       : array[1..MaxN]of record X,Y : longint end;
      a,b,R   : extended;
      N,i,j   : longint;
      MinI,kI : longint;
      W       : extended;

Procedure Solve(x1,y1,x2,y2,x3,y3 : longint);
Var t1,t2,t3,u1,u2,u3 : longint;
 begin
  t1:=2*(x1-x2);
  u1:=2*(x3-x2);
  t2:=2*(y1-y2);
  u2:=2*(y3-y2);
  t3:=x2*x2+y2*y2-x1*x1-y1*y1;
  u3:=x2*x2+y2*y2-x3*x3-y3*y3;
  if t1<>0 then begin
    b:=-(u3-(t3*u1)/t1)/(u2-(u1*t2)/t1);
    a:=-b*(t2/t1)-(t3/t1);
   end else begin
    b:=-t3/t2;
    a:=-(b*u2+u3)/u1;
   end;
  R:=sqrt(sqr(x1-a)+sqr(y1-b));
 end;

Function GetDist(x1,y1,x2,y2 : extended) : extended;
 begin
  GetDist:=Sqrt(Sqr(x1-x2)+Sqr(y1-y2));
 end;

Function Check(a1,a2,a3 : integer) : boolean;
Var i,ls,gr   : integer;
    d         : extended;
 begin
  Solve(C[a1].X,C[a1].Y,C[a2].X,C[a2].Y,C[a3].X,C[a3].Y);
  ls:=0;
  gr:=0;
  for i:=1 to N do
   if i<>a1 then
    if i<>a2 then
     if i<>a3 then begin
      d:=GetDist(a,b,C[i].X,C[i].Y);
      if d<R then ls:=ls+1 else gr:=gr+1;
     end;
  Check:=(ls=gr);
 end;

begin
 Read(N);
 for i:=1 to N do Read(C[i].X,C[i].Y);
 MinI:=1;
 for i:=2 to N do
  if (C[i].Y<C[MinI].Y)or((C[i].Y=C[MinI].Y)and(C[i].X<C[MinI].X))
then
   MinI:=i;
 W:=-1;
 for i:=1 to N do
  if i<>MinI then begin
   if C[i].Y=C[MinI].Y then begin kI:=i; break; end;
   if abs(C[i].X-C[MinI].X)/(C[i].Y-C[MinI].Y)>W then begin
     W:=abs(C[i].X-C[MinI].X)/(C[i].Y-C[MinI].Y);
     kI:=i;
    end;
  end;
 for i:=1 to N do
  if i<>MinI then
   if i<>kI then
    if Check(MinI,kI,i) then begin
     Writeln(C[MinI].X,' ',C[MinI].Y);
     Writeln(C[kI].X,' ',C[kI].Y);
     Writeln(C[i].X,' ',C[i].Y);
    end;
end.
I use FullSearch and also WA!(+)
Послано Nazarov Denis (nsc2001@rambler.ru) 18 фев 2002 23:07
Program t1103;{$N+}

Const Eps     = 1E-10;
      MaxN    = 5000;

Var   C       : array[1..MaxN]of record X,Y : longint end;
      a,b,R   : extended;
      N,i,j   : longint;
      MinI,kI : longint;
      W       : extended;

Procedure Solve(x1,y1,x2,y2,x3,y3 : longint);
Var t1,t2,t3,u1,u2,u3 : longint;
 begin
  t1:=2*(x1-x2);
  u1:=2*(x3-x2);
  t2:=2*(y1-y2);
  u2:=2*(y3-y2);
  t3:=x2*x2+y2*y2-x1*x1-y1*y1;
  u3:=x2*x2+y2*y2-x3*x3-y3*y3;
  if t1<>0 then begin
    b:=-(u3-(t3*u1)/t1)/(u2-(u1*t2)/t1);
    a:=-b*(t2/t1)-(t3/t1);
   end else begin
    b:=-t3/t2;
    a:=-(b*u2+u3)/u1;
   end;
  R:=sqrt(sqr(x1-a)+sqr(y1-b));
 end;

Function GetDist(x1,y1,x2,y2 : extended) : extended;
 begin
  GetDist:=Sqrt(Sqr(x1-x2)+Sqr(y1-y2));
 end;

Function Check(a1,a2,a3 : integer) : boolean;
Var i,ls,gr   : integer;
    d         : extended;
 begin
  Solve(C[a1].X,C[a1].Y,C[a2].X,C[a2].Y,C[a3].X,C[a3].Y);
  ls:=0;
  gr:=0;
  for i:=1 to N do
   if i<>a1 then
    if i<>a2 then
     if i<>a3 then begin
      d:=GetDist(a,b,C[i].X,C[i].Y);
      if d<R then ls:=ls+1 else gr:=gr+1;
     end;
  Check:=(ls=gr);
 end;

begin
 Read(N);
 for i:=1 to N do Read(C[i].X,C[i].Y);
 for MinI:=1 to N-2 do
  for kI:=MinI+1 to N-1 do
   for i:=kI+1 to N do
    if Check(MinI,kI,i) then begin
     Writeln(C[MinI].X,' ',C[MinI].Y);
     Writeln(C[kI].X,' ',C[kI].Y);
     Writeln(C[i].X,' ',C[i].Y);
     Halt(0);
    end;
end.