VPF::[Pascal] Определение кратчайшего расстояния

Gigabyte

Дата 15.10.2006, 15:36 (ссылка)

(нет голосов)

Загрузка ...

Студент-халявщик

Профиль
Группа: Участник
Сообщений: 305
Регистрация: 1.11.2004
Где: ПЫтер

Репутация: 1
Всего: 3

с клавиатуры вводяться координаты точки и радиус
надо определить кратчайшее растояние от точки до графика

Это сообщение отредактировал(а) Gigabyte - 15.10.2006, 15:38

Присоединённый файл ( Кол-во скачиваний: 22 )

lab.jpg 1,98 Kb

--------------------

Alexeis

Дата 15.10.2006, 16:22 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 23
Всего: 459

Код


program Project2;

{$N+}

var
  x0, y0, R : Double;

begin
  Write(' x0='); read(x0); writeln;
  Write(' y0='); read(y0); writeln;
  Write(' R=');   read(R);  writeln;
  Write(' L=', Sqrt((x0 * x0 + y0 * y0) * (1 - R / Sqrt(x0 * x0 + y0 * y0))) : 5 : 5);
  Readln;
  Readln;
end.

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Kuvaldis

Дата 15.10.2006, 20:15 (ссылка)

(нет голосов)

Загрузка ...

механик-вредитель

Профиль
Группа: Участник Клуба
Сообщений: 1189
Регистрация: 16.6.2006
Где: Минск

Репутация: 32
Всего: 61

Gigabyte,
Если решить, что автор задачи не опечатался, когда рисовал окружность без ее части во второй четверти, то вариант решения такой
program Project2;

Код


var
  x0, y0, R, L : Double;
begin
  Write(' x0 = '); read(x0); writeln;
  Write(' y0 = '); read(y0); writeln;
  Write(' R = ');  read(R);  writeln;

  // if 2 quater
  if (x0 * y0 < 0) and (x0 < 0) then
  begin
     if (y0 > -x0) then
        L := Sqrt(x0 * x0 + (y0 - R) * (y0 - R))
     else
        L := Sqrt(y0 * y0 + (x0 - R) * (x0 - R))
  end
  else
     L := Abs( Sqrt(x0 * x0 + y0 * y0) - R);

  Writeln(' L=', L : 5 : 5);
  Readln;
  Readln;
end.

--------------------

Помни - когда ты спишь, враг не дремлет
Спи чаще и дольше, изматывай врага бессоницей

Gigabyte

Дата 15.10.2006, 20:41 (ссылка)

(нет голосов)

Загрузка ...

Студент-халявщик

Профиль
Группа: Участник
Сообщений: 305
Регистрация: 1.11.2004
Где: ПЫтер

Репутация: 1
Всего: 3

во 2 четверти график представляет собой 2 отрезка проходящие из точки (0,0)
по осям до окружности

--------------------

Kuvaldis

Дата 16.10.2006, 00:54 (ссылка)

(нет голосов)

Загрузка ...

механик-вредитель

Профиль
Группа: Участник Клуба
Сообщений: 1189
Регистрация: 16.6.2006
Где: Минск

Репутация: 32
Всего: 61

Gigabyte,
модифицированный вариант

Код


program Project2;
{$N+}
var
  x0, y0, R, L : Double;
  
//*****************************************************************************
function Min(a, b : double) : double;
begin
    if (a <= b) then
       Min := a
    else
       Min := b;
end;
//*****************************************************************************
procedure Process_2_Quater;
begin
    if (y0 > -x0) then
    begin
        if (y0 <= R) then
          L := -x0
        else
          L := Sqrt(x0 * x0 + (y0 - R) * (y0 - R))
    end
    else
    begin
        if (-x0 <= R) then
          L := y0
        else
          L := Sqrt(y0 * y0 + (x0 - R) * (x0 - R))
    end;
end;
//*****************************************************************************
procedure Process_3_Quater;
var
    len : double;
begin
    len := sqrt(x0 * x0 + y0 * y0);

    if (len >= R) then     // if outside of circle
        L := len - R
    else
       L := Min(R - len, -y0);
end;
//*****************************************************************************
procedure Process_1_Quater;
var
    len : double;
begin
    len := sqrt(x0 * x0 + y0 * y0);

    if (len >= R) then     // if outside of circle
        L := len - R
    else
       L := Min(R - len, x0);
end;
//*****************************************************************************
procedure Process_4_Quater;
var
    len : double;
begin
    len := sqrt(x0 * x0 + y0 * y0);

    if (len >= R) then     // if outside of circle
        L := len - R
    else
       L := Min(R - len, len);  
end;
//*****************************************************************************
begin
  Write(' x0 = '); read(x0); writeln;
  Write(' y0 = '); read(y0); writeln;
  Write(' R = ');  read(R);  writeln;
  
  if (x0 * y0 <= 0) and (x0 <= 0) then
    Process_2_Quater
  else if (x0 * y0 >= 0) and (x0 <= 0) then
    Process_3_Quater
  else if (x0 * y0 >= 0) and (x0 > 0) then
    Process_1_Quater
  else
    Process_4_Quater;

  Writeln(' L=', L : 5 : 5);
  Readln;
  Readln;
end.
//*****************************************************************************

Это сообщение отредактировал(а) Kuvaldis - 16.10.2006, 08:32

--------------------

Помни - когда ты спишь, враг не дремлет
Спи чаще и дольше, изматывай врага бессоницей

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »