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

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

Compilation Error. Why? Help me, please.
Послано Timur 18 апр 2002 10:19
{Written by Luguev Timur}
{$n+}
uses crt;
const max=32767;
var
  input,out:text;
  n,i,j:byte;
  c:array[1..100,1..4] of integer;
  res:array[1..100] of extended;
  xp,yp:integer;

procedure load;
begin
  readln(input,n);
  for i:=1 to n do
  begin
    read(input,c[i,1]);
    read(input,c[i,2]);
    read(input,c[i,3]);
    readln(input,c[i,4]);
  end;
  read(input,xp);
  read(input,yp);
end;

function dbetp(x1,y1,x2,y2:extended):extended;
begin
  dbetp:=sqrt(sqr(x2-x1)+sqr(y2-y1));
end;
{-------------------------------------------------------}
function finddistance(x1,y1,x3,y3:integer):extended;
var
  x2,y2,x4,y4,x,y:extended;
  k12,k23,k34,k41,k,c12,c23,c34,c41:extended;
  d:extended;
procedure findcoord(k,c,x1,y1:extended;var x,y:extended);
var c1:extended;
begin
  c1:=y1+x1/k;
  x:=(k*(c1-c))/(sqr(k)-1);
  y:=(sqr(k)*(c1-c))/(sqr(k)-1)+c;
end;

procedure findk;
begin
  k:=(y3-y1)/(x3-x1);
  k12:=(1+k)/(1-k);
  k34:=k12;
  k23:=(k-1)/(1+k);
  k41:=k23;
  c12:=y1-k12*x1;
  c23:=y3-k23*x3;
  c34:=y3-k34*x3;
  c41:=y1-k41*x1;
end;

procedure findxy;
begin
  if x1=x3 then
  begin
    if y3>y1 then
    begin
      x2:=x1-abs(x2-x3);
      x4:=x1+abs(x2-x3);
      y2:=(y3-y1)/2;
      y4:=y2;
    end
    else
    begin
      x2:=x1+abs(x2-x3);
      x4:=x1-abs(x2-x3);
      y2:=(y1-y3)/2;
      y4:=y2;
    end;
    exit;
  end;
  if y1=y3 then
  begin
    if x3>x1 then
    begin
      x2:=(x1+x3)/2;
      x4:=x2;
      y2:=(x3-x1)/2+y1;
      y4:=y1-(x3-x1)/2;
    end
    else
    begin
      x2:=(x1+x3)/2;
      x4:=x2;
      y4:=(x1-x3)/2+y1;
      y2:=y1-(x1-x3)/2;
    end;
    exit;
  end;
  findk;
  findcoord(k23,c23,x1,y1,x2,y2);
  findcoord(k34,c34,x1,y1,x4,y4);
end;
procedure exception;
var
  a,b,c,l:extended;
begin
  if (x3>x1) and (y3<y1) then
  begin
    a:=x1;
    c:=x3;
    b:=y1;
    l:=y3;
  end;
  if (x3<x1) and (y3>y1) then
  begin
    a:=x3;
    c:=x1;
    b:=y3;
    l:=y1;
  end;
  if (x3>x1) and (y3>y1) then
  begin
    a:=x1;
    b:=y3;
    c:=x3;
    l:=y1;
  end;
  if (x3<x1) and (y3<y1) then
  begin
    a:=x3;
    b:=y1;
    c:=x1;
    l:=y3
  end;
  if (xp>=a) and (xp<=c) and (yp<=b) and (yp>=l) then
  begin
    d:=0;
    exit;
  end;
  if (xp<a) and (yp>b) then d:=dbetp(xp,yp,a,b);
  if (xp>=a) and (xp<=c) and (yp>b) then d:=yp-b;
  if (xp>c) and (yp>b) then d:=dbetp(xp,yp,c,b);
  if (xp<a) and (yp<=b) and (yp>=l) then d:=a-xp;
  if (xp>c) and (yp<=b) and (yp>=l) then d:=xp-c;
  if (xp<a) and (yp<l) then d:=dbetp(xp,yp,a,l);
  if (xp>=a) and (xp<=c) and (yp<l) then d:=l-yp;
  if (xp>c) and (yp<l) then d:=dbetp(xp,yp,c,l);
end;
function test:boolean;
var
  x12,y12,x23,y23,x34,y34,x41,y41:extended;
begin
  test:=false;
  findcoord(k12,c12,xp,yp,x12,y12);
  findcoord(k23,c23,xp,yp,x23,y23);
  findcoord(k34,c34,xp,yp,x34,y34);
  findcoord(k12,c12,xp,yp,x41,y41);
  if ((dbetp(x12,y12,xp,yp)+dbetp(x34,y34,xp,yp))=dbetp
(x12,y12,x34,y34)) and
  ((dbetp(x23,y23,xp,yp)+dbetp(x41,y41,xp,yp))=dbetp
(x23,y23,x41,y41)) then
  test:=true;
end;
begin
  if (x3=x1) and (y1=y3) then
  begin
    finddistance:=dbetp(x1,y1,xp,yp);
    exit;
  end;
  if (abs(x3-x1)=abs(y3-y1)) then
  begin
    exception;
    finddistance:=d;
    exit;
  end;
  findxy;
  if test then
  begin
    finddistance:=0;
    exit;
  end;
  d:=max;
  if dbetp(x1,y1,xp,yp)<d then d:=dbetp(x1,y1,xp,yp);
  if dbetp(x2,y2,xp,yp)<d then d:=dbetp(x2,y2,xp,yp);
  if dbetp(x3,y3,xp,yp)<d then d:=dbetp(x3,y3,xp,yp);
  if dbetp(x4,y4,xp,yp)<d then d:=dbetp(x4,y4,xp,yp);
  findcoord(k12,c12,xp,yp,x,y);
  if ((dbetp(x,y,x1,y1
Maybe the readkey at end(-)
Послано ijk 18 апр 2002 12:19
> {Written by Luguev Timur}
> {$n+}
> uses crt;
> const max=32767;
> var
>   input,out:text;
>   n,i,j:byte;
>   c:array[1..100,1..4] of integer;
>   res:array[1..100] of extended;
>   xp,yp:integer;
>
> procedure load;
> begin
>   readln(input,n);
>   for i:=1 to n do
>   begin
>     read(input,c[i,1]);
>     read(input,c[i,2]);
>     read(input,c[i,3]);
>     readln(input,c[i,4]);
>   end;
>   read(input,xp);
>   read(input,yp);
> end;
>
> function dbetp(x1,y1,x2,y2:extended):extended;
> begin
>   dbetp:=sqrt(sqr(x2-x1)+sqr(y2-y1));
> end;
> {-------------------------------------------------------}
> function finddistance(x1,y1,x3,y3:integer):extended;
> var
>   x2,y2,x4,y4,x,y:extended;
>   k12,k23,k34,k41,k,c12,c23,c34,c41:extended;
>   d:extended;
> procedure findcoord(k,c,x1,y1:extended;var x,y:extended);
> var c1:extended;
> begin
>   c1:=y1+x1/k;
>   x:=(k*(c1-c))/(sqr(k)-1);
>   y:=(sqr(k)*(c1-c))/(sqr(k)-1)+c;
> end;
>
> procedure findk;
> begin
>   k:=(y3-y1)/(x3-x1);
>   k12:=(1+k)/(1-k);
>   k34:=k12;
>   k23:=(k-1)/(1+k);
>   k41:=k23;
>   c12:=y1-k12*x1;
>   c23:=y3-k23*x3;
>   c34:=y3-k34*x3;
>   c41:=y1-k41*x1;
> end;
>
> procedure findxy;
> begin
>   if x1=x3 then
>   begin
>     if y3>y1 then
>     begin
>       x2:=x1-abs(x2-x3);
>       x4:=x1+abs(x2-x3);
>       y2:=(y3-y1)/2;
>       y4:=y2;
>     end
>     else
>     begin
>       x2:=x1+abs(x2-x3);
>       x4:=x1-abs(x2-x3);
>       y2:=(y1-y3)/2;
>       y4:=y2;
>     end;
>     exit;
>   end;
>   if y1=y3 then
>   begin
>     if x3>x1 then
>     begin
>       x2:=(x1+x3)/2;
>       x4:=x2;
>       y2:=(x3-x1)/2+y1;
>       y4:=y1-(x3-x1)/2;
>     end
>     else
>     begin
>       x2:=(x1+x3)/2;
>       x4:=x2;
>       y4:=(x1-x3)/2+y1;
>       y2:=y1-(x1-x3)/2;
>     end;
>     exit;
>   end;
>   findk;
>   findcoord(k23,c23,x1,y1,x2,y2);
>   findcoord(k34,c34,x1,y1,x4,y4);
> end;
> procedure exception;
> var
>   a,b,c,l:extended;
> begin
>   if (x3>x1) and (y3<y1) then
>   begin
>     a:=x1;
>     c:=x3;
>     b:=y1;
>     l:=y3;
>   end;
>   if (x3<x1) and (y3>y1) then
>   begin
>     a:=x3;
>     c:=x1;
>     b:=y3;
>     l:=y1;
>   end;
>   if (x3>x1) and (y3>y1) then
>   begin
>     a:=x1;
>     b:=y3;
>     c:=x3;
>     l:=y1;
>   end;
>   if (x3<x1) and (y3<y1) then
>   begin
>     a:=x3;
>     b:=y1;
>     c:=x1;
>     l:=y3
>   end;
>   if (xp>=a) and (xp<=c) and (yp<=b) and (yp>=l) then
>   begin
>     d:=0;
>     exit;
>   end;
>   if (xp<a) and (yp>b) then d:=dbetp(xp,yp,a,b);
>   if (xp>=a) and (xp<=c) and (yp>b) then d:=yp-b;
>   if (xp>c) and (yp>b) then d:=dbetp(xp,yp,c,b);
>   if (xp<a) and (yp<=b) and (yp>=l) then d:=a-xp;
>   if (xp>c) and (yp<=b) and