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

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

WA HELP 2
Послано Oleg 16 янв 2003 09:20
var i,j,k,n,m:integer;
    x,y:integer;
    a:array [1..100,1..4] of integer;
    r:array [0..100] of real;
    b:array [0..100] of integer;


function minr(a,b : real):real;
begin
   if a<b then minr := a else minr := b;
end;

function min(a,b : integer):integer;
begin
   if a<b then min := a else min := b;
end;

function max(a,b : integer):integer;
begin
   if a>b then max := a else max := b;
end;

function len(x1,y1,x2,y2: real):real;
begin
   len := sqrt(sqr(x2-x1)+sqr(y2-y1));
end;

function ins(x1,x2,x : integer) : boolean;
begin
   if (x>=min(x1,x2)) and (x<=max(x1,x2)) then begin
      ins := true;
   end else ins := false;
end;

function sq_dis(x1,y1,x2,y2 : integer): real;
var d1,d2,d3,d4 : real;
begin
   if ins(x1,x2,x) and ins(y1,y2,y) then begin
      sq_dis := 0;
      exit;
   end;
   if ins(x1,x2,x) then
   begin
    d1:=abs(y1-y);
    d2:=abs(y2-y);
    d3:=abs(y1-y);
    d4:=abs(y2-y);
   end else begin
    if ins(y1,y2,y) then
    begin
     d1:=abs(x1-x);
     d2:=abs(x2-x);
     d3:=abs(x1-x);
     d4:=abs(x1-x);
    end else begin
     d1:=len(x1,y1,x,y);
     d2:=len(x2,y2,x,y);
     d3:=len(x2,y1,x,y);
     d4:=len(x1,y2,x,y);
    end;
   end;
  sq_dis := minr(minr(minr(d1,d2),d3),d4);
end;

function proov(k:integer):real;
var x1,x2,y1,y2:integer;
 function min(a,b:integer):integer;
 begin
  if a<b then min:=a else min:=b;
 end;

 function max(a,b:integer):integer;
 begin
  if a>b then max:=a else max:=b;
 end;
begin
 x1:=min(a[k,1],a[k,3]);
 y1:=max(a[k,2],a[k,4]);
 x2:=max(a[k,1],a[k,3]);
 y2:=min(a[k,2],a[k,4]);
 proov:=sq_dis(x1,y1,x2,y2);
end;

begin
 read(n);
 for i:=1 to n do
 begin
  for j:=1 to 4
  do read(a[i,j]);
  b[i]:=i;
 end;
 read(x,y);
 for i:=1 to n do r[i]:=proov(i);
 for i:=1 to n do
 begin
  for j:=i+1 to n do
  begin
   if r[i]>r[j] then
   begin
    r[0]:=r[i]; r[i]:=r[j]; r[j]:=r[0];
    b[0]:=b[i]; b[i]:=b[j]; b[j]:=b[0];
   end;
  end;
 end;
 for i:=1 to n do writeln(b[i],' ',r[i]:0:0)
end.
WA AGAIN
Послано Oleg 16 янв 2003 14:14
const eps=1e-14;
var i,j,k,n,m:integer;
    x,y:integer;
    a:array [1..100,1..4] of integer;
    r:array [0..100] of real;
    b:array [0..100] of integer;


function minr(a,b : real):real;
begin
   if a<b then minr := a else minr := b;
end;

function min(a,b : integer):integer;
begin
   if a<b then min := a else min := b;
end;

function max(a,b : integer):integer;
begin
   if a>b then max := a else max := b;
end;

function len(x1,y1,x2,y2: real):real;
begin
   len := sqrt(sqr(x2-x1)+sqr(y2-y1));
end;

function ins(x1,x2,x : integer) : boolean;
begin
   if (x>=min(x1,x2)) and (x<=max(x1,x2)) then begin
      ins := true;
   end else ins := false;
end;

function sq_dis(x1,y1,x2,y2 : integer): real;
var d1,d2,d3,d4 : real;
begin
   if ins(x1,x2,x) and ins(y1,y2,y) then begin
      sq_dis := 0;
      exit;
   end;
   if ins(x1,x2,x) then
   begin
    d1:=abs(y1-y);
    d2:=abs(y2-y);
    d3:=abs(y1-y);
    d4:=abs(y2-y);
   end else begin
    if ins(y1,y2,y) then
    begin
     d1:=abs(x1-x);
     d2:=abs(x2-x);
     d3:=abs(x1-x);
     d4:=abs(x1-x);
    end else begin
     d1:=len(x1,y1,x,y);
     d2:=len(x2,y2,x,y);
     d3:=len(x2,y1,x,y);
     d4:=len(x1,y2,x,y);
    end;
   end;
  sq_dis := minr(minr(minr(d1,d2),d3),d4);
end;

function proov(k:integer):real;
var x1,x2,y1,y2:integer;
 function min(a,b:integer):integer;
 begin
  if a<b then min:=a else min:=b;
 end;

 function max(a,b:integer):integer;
 begin
  if a>b then max:=a else max:=b;
 end;
begin
 x1:=min(a[k,1],a[k,3]);
 y1:=max(a[k,2],a[k,4]);
 x2:=max(a[k,1],a[k,3]);
 y2:=min(a[k,2],a[k,4]);
 proov:=sq_dis(x1,y1,x2,y2);
end;

begin
 read(n);
 for i:=1 to n do
 begin
  for j:=1 to 4
  do read(a[i,j]);
  b[i]:=i;
 end;
 read(x,y);
 for i:=1 to n do r[i]:=proov(i);
 for i:=1 to n do
 begin
  for j:=i+1 to n do
  begin
   if (r[i]-r[j])>eps then
   begin
    r[0]:=r[i]; r[i]:=r[j]; r[j]:=r[0];
    b[0]:=b[i]; b[i]:=b[j]; b[j]:=b[0];
   end;
  end;
 end;
 for i:=1 to n do
 begin
  for j:=i+1 to n do
  begin
   if (abs(r[i]-r[j])<eps) and (b[i]>b[j]) then
   begin
    r[0]:=r[i]; r[i]:=r[j]; r[j]:=r[0];
    b[0]:=b[i]; b[i]:=b[j]; b[j]:=b[0];
   end;
  end;
 end;
 for i:=1 to n-1 do write(b[i],' '); writeln(b[n]);
end.