Помощь - Поиск - Пользователи - Календарь
Полная версия: Расстояние между точками
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
RIDDICK
Помогите пожалуйста решить задачку:

На плоскости расположено 10 точек, которые заданы своими координатами. Найти на оси абсцисс точку, наибольшее из расстояний от которой до выбранных точек было бы минимальным.

Надеюсь на вас, "акулы форума"
Altair
Это интересная задача...
Вот ее оригинальный вариант:
Цитата
В некой области есть N населенных пунктов. Решено было построить на железной дороге еще одну станцию, так, что бы она была расположенна максимально "справедливо" - максимальное расстояние до нас. пункта было бы минимальным."

Что интересно, применение алгоритма решения дает решения идругих задач, внешне не похожих на эту.

Вот пример решенной, подобной задачи.
(1 решение).
(думаю переделать его под себя не составит труда)
Если будут вопросы, задавайте. (кстати у меня есть решение этой задачи из книги 1986 года. Вот так :P )
hiv
Вот решение задачи. Эта задача на оптимизацию. Есть некая функция F(X) - нужно найти ее минимум. Берем из нее производную по X и, приравнивая ее к нулю, получаем оптимальное значение X, т.е. F'(Xmin)=0
Это уравнение решаем любым численным методом - в данном случае "метод простых итераций".

Код
program TCHK;
uses crt;

const count=10;        {количество точек}
     epsilon=1E-6;    {точность вычислений}

type TRPoint = record
      X,Y :extended;
    end;

{ в массиве P задаем координаты точек}
const P :array [1..count] of TRPoint =(
(X: 2.5; Y: 2.0),
(X: 3.0; Y:-3.0),
(X: 3.5; Y: 4.0),
(X: 4.0; Y: 1.0),
(X: 4.5; Y:-4.0),
(X: 5.0; Y:-2.0),
(X: 5.5; Y: 5.0),
(X: 6.0; Y: 7.0),
(X: 6.5; Y:-9.0),
(X: 7.0; Y: 1.0)
);

var i :integer;
   x,x0,M :extended;

function SummaRast(x:extended):extended; {подсчет суммы расстояний от точки X до всех остальных точек}
var  i :integer;
    s :extended;
begin
 s:=0;
 for i:=1 to count do s:=s+sqrt(P[i].Y*P[i].Y+(x-P[i].X)*(x-P[i].X));
 SummaRast:=s;
end;

function MinFunc(x:extended):extended; {производная функции суммы расстояний}
var  i :integer;
    s :extended;
begin
 s:=0;
 for i:=1 to count do s:=s+(x-P[i].X)/sqrt(P[i].Y*P[i].Y+(x-P[i].X)*(x-P[i].X));
 MinFunc:=s;
end;

begin {основная программа}
 clrscr;

 x0:=0;
 for i:=1 to count do x0:=x0+P[i].X;
 x:=x0/count; {среднее значение координат точек по оси абсцисс}
 writeln('Начальное приближение x=',x);

 M:=-(MinFunc(x+epsilon)-MinFunc(x))/epsilon; {коэффициент для улучшения сходимости}

 i:=0;
 repeat
   x0:=x;
   x:=x0+MinFunc(x0)/M; {метод простых итераций}
   inc(i);
   writeln('Итерация ',i:0,'---------------------------');
   writeln('x=',x,' точность=',abs(x-x0));
   writeln('MinFunc=',MinFunc(x),' SummaRast=',SummaRast(x));
 until (abs(x-x0)<epsilon)or(i>100);

 if (abs(x-x0)<epsilon) then writeln('Ответ: X=',x)
 else writeln('Ответ не найден! За 100 шагов итерация не сошлась.');

end.


Пробуйте... smile.gif
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.