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

Обсуждение задачи 1111. Квадраты

help me WA3!! code included!!
Послано Нищий Наглец 17 июл 2005 18:39
{$N+}
type kor=record
       x,y:longint;
    end;
var
m:array[1..100,1..4]of kor;
Sort:array[1..100]of byte;
l:array[1..100]of longint;
t:kor;
l1,max:longint;
j,i,n,tmp:byte;

procedure Swep(var a,b:byte);
begin  tmp:=a; a:=b; b:=tmp;   end;

begin
readln(n);
for i:=1 to n do
  begin
    readln(m[i,1].x,m[i,1].y,m[i,2].x,m[i,2].y);
    if m[i,1].x>m[i,2].x then
       begin
        t.x:=m[i,1].x;
        m[i,1].x:=m[i,2].x;
        m[i,2].x:=t.x;
       end;

    if m[i,1].y>m[i,2].y then
       begin
        t.y:=m[i,1].y;
        m[i,1].y:=m[i,2].y;
        m[i,2].y:=t.y;
       end;

    m[i,3].x:=m[i,1].x;
    m[i,3].y:=m[i,2].y;
    m[i,4].x:=m[i,2].x;
    m[i,4].y:=m[i,1].y;
  end;

readln(t.x,t.y);

for i:=1 to n do
  begin
   max:=2147483647;
    for j:=1 to 4 do
       begin
         l1:=sqr(m[i,j].x-t.x)+sqr(m[i,j].y-t.y);
         if max>l1 then max:=l1;
       end;

   if (t.y>m[i,1].y)and(t.y<m[i,4].y)and(max>abs(m[i,1].x-t.x)) then max:=sqr(m[i,1].x-t.x);
   if (t.y>m[i,3].y)and(t.y<m[i,2].y)and(max>abs(m[i,2].x-t.x)) then max:=sqr(m[i,2].x-t.x);

   if (t.x>m[i,4].x)and(t.x<m[i,2].x)and(max>abs(m[i,2].y-t.y)) then max:=sqr(m[i,2].y-t.y);
   if (t.x>m[i,1].x)and(t.x<m[i,3].x)and(max>abs(m[i,3].y-t.y)) then max:=sqr(m[i,3].y-t.y);

   if (t.x>=m[i,1].x)and(t.x<=m[i,2].x)and(t.y>=m[i,1].y)and(t.y<=m[i,2].y) then max:=0;

   l[i]:=max;
  end;

for i:=1 to n do sort[i]:=i;

for i:=1 to n do
 for j:=1 to n-1 do
   begin
   if l[sort[j]]>l[sort[j+1]] then swep(sort[j],sort[j+1]);
   if (l[sort[j]]=l[sort[j+1]])and(sort[j]>sort[j+1]) then swep(sort[j],sort[j+1]);

   end;

for i:=1 to n do  write(sort[i],' ');

end.


HELP!!!!!!!!!
Are you sure that you understood problem? (-)
Послано Victor Barinov (TNU) 17 июл 2005 18:44
Re: Are you sure that you understood problem? (-)
Послано Нищий Наглец 17 июл 2005 19:08

I am not very sure!!! :)