Версия для печати темы
Нажмите сюда для просмотра этой темы в обычном формате
Форум «Всё о Паскале» _ Задачи _ Расстояние между точками
Автор: RIDDICK 1.03.2005 5:34
Помогите пожалуйста решить задачку:
На плоскости расположено 10 точек, которые заданы своими координатами. Найти на оси абсцисс точку, наибольшее из расстояний от которой до выбранных точек было бы минимальным.
Надеюсь на вас, "акулы форума"
Автор: Altair 1.03.2005 11:43
Это интересная задача...
Вот ее оригинальный вариант:
Цитата
В некой области есть N населенных пунктов. Решено было построить на железной дороге еще одну станцию, так, что бы она была расположенна максимально "справедливо" - максимальное расстояние до нас. пункта было бы минимальным."
Что интересно, применение алгоритма решения дает решения идругих задач, внешне не похожих на эту.
http://forum.pascal.net.ru/index.php?showtopic=2898&hl=центр++описанной++окружности
(1 решение).
(думаю переделать его под себя не составит труда)
Если будут вопросы, задавайте. (кстати у меня есть решение этой задачи из книги 1986 года. Вот так :P )
Автор: hiv 1.03.2005 17:43
Вот решение задачи. Эта задача на оптимизацию. Есть некая функция 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.
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.
Пробуйте...
