трехмерное пространство, найти радиус Опции

[bairt]

В трехмерном пространстве задано N шаров. Найти шар минимального радиуса, охватывающий все заданные

[Altair]

Есть задача решенная - найти окружность, в которую вместяться все точки на плоскости.
Расширяем задачу на 3d , получаем найти шар....
И потом добавляем к точкам уловие того, что они имеют размер.
Таким образом задача решается.

[volvo]

<...>

[Lapp]

volvo, давай рассмотрим частный стучай.
Две сферы, одна с центром в точке (-1,-1,-1), а другая в (1,1,1). Радиусы обеих сфер нулевые. Твой алгоритм даст диаметр, равный 2. На самом же деле он равен Sqrt(3).

Сообщение отредактировано: lapp - 23.04.2006 12:46

[volvo]

Ну, во-первых, не Sqrt(3), а 2*Sqrt(3)

Если уже взялся что-то опровергать, то делай это ПРАВИЛЬНО.

[Lapp]

Ну, во-первых, не Sqrt(3), а 2*Sqrt(3)

Если уже взялся что-то опровергать, то делай это ПРАВИЛЬНО.

Извиняюсь. Ошибся. 2*Sqrt(3). И вовсе незачем кричать.

[klem4]

А есть данные для теста ? А то вот накатал кое что а проверить не могу ;)

[klem4]

В общем вот что пока есть.На соклько я вижу отличается от того что предложил вольво, но возможно тоже имеет место быть ... и всетаки было-бы не плохо увидеть тестовый пример

{$N+}
uses crt;
const
  n = 5;
type

  TSphere = record
    x, y, z, r : word;
  end;

  TSArr   = array [1..n] of TSphere;

procedure Fill(var s : TSArr);
var
  i : word;
begin
  for i := 1 to n do
   with s[i] do begin
     write(i , ').');
     readln(x, y, z, r);
  end;
end;

function Len(P1, P2 : TSPhere) : single;
begin
  Len := sqrt
               (
               (P2.x - P1.x) * (P2.x - P1.x) +
               (P2.y - P1.y) * (P2.y - P1.y) +
               (P2.z - P1.z) * (P2.z - P1.z)
               );
end;

function IsIncludeAll(s : TSArr; m : word) : boolean;
var
  i : word;
begin
  i := 1;
  while (i <= n) and (Len(s[i], s[m]) + s[i].r <= s[m].r)
   do inc(i);
  IsIncludeAll := (i > n);
end;


function Find(s : TSArr) : word;
var
  i, min : word;
begin
  min := 0;
  i := 1;
  while (i <= n) do begin
    if IsIncludeAll(s, i) then
     min := i;
    inc(i);
  end;
  Find := min;
end;

var
  Sp : TSArr;

begin
  clrscr;
  Fill(Sp);
  writeln(Find(Sp));
  readln;
end.

гыя вообще не то что надо решил )))

Volvo, ага тока щас понял ) Еще ведь долго думал как это может быть минимальная среди имеющихся, которая охватыет все остальные :D

[volvo]

klem4, ты, если я не ошибаюсь, решаешь несколько другую задачу? Ты пытаешься найти сферу из тех, что заданы?

[klem4]

Вот такой вариант ... но опятьже нужен тестовые данные ... Вариант годится для случая елси центр хотябы одной сферы не совпадает с центрами остальных, в противном случае берем просто наибольший радиус + 1 ...

{$N+}
uses crt;
const
  n = 2;
type

  TSphere = record
    x, y, z, r : word;
  end;

  TSArr   = array [1..n] of TSphere;

procedure Fill(var s : TSArr);
var
  i : word;
begin
  for i := 1 to n do
   with s[i] do begin
     write(i , ').');
     readln(x, y, z, r);
  end;
end;

function Len(P1, P2 : TSPhere) : word;
begin
  Len := round(sqrt
               (
               (P2.x - P1.x) * (P2.x - P1.x) +
               (P2.y - P1.y) * (P2.y - P1.y) +
               (P2.z - P1.z) * (P2.z - P1.z)
               ));
end;

function GetRadius(s : TSArr) : word;
var
  i, j, p1, p2, L: word;
  maxL : integer;
begin
  maxL := -maxint;
  for i := 1 to n - 1 do
   for j := i + 1 to n do begin
     L := Len(s[i], s[j]);
     if L >= maxL then begin
        maxL := L;
        p1 := i;
        p2 := j;
     end;
   end ;

   GetRadius := maxL + s[p1].r + s[p2].r;
end;

var
  Sp : TSArr;

begin
  clrscr;
  Fill(Sp);
  writeln(GetRadius(Sp));
  readln;
end.

К сожалению решение не верное =(

[Бравый генерал]

klem4, как видно из твоего кода, ты находил две сферы, которые расположены дальше всего друг от друга. Да, такой вариант неверен. Я сегодня долго думал над этой интересной задачкой и для наглядности сначала делал с окружностями, типа в 2D Так вот в таком варианте как у тебя бывают случаи (окружности задаются случайно), что какая-то окружность может даже ЦЕЛИКОМ выйти за "охватывающую" окружность. Ну, например, чтобы найти окружность, охватывающую множество точек, нужно найти две максимально удаленные точки M и N, найти еще одну точку, максимально удаленную от отрезка MN, и построить по этим трем точкам окружность. Наша же задача сводится к задаче "найти окружность, охватывающую множество окружностей" (2D перевести в 3D не представится сложным). Так вот вопрос: как найти точки A, B и C на прилагаемом мной рисунке?

[volvo]

<...>

[Lapp]

Наша же задача сводится к задаче "найти окружность, охватывающую множество окружностей" (2D перевести в 3D не представится сложным). Так вот вопрос: как найти точки A, B и C на прилагаемом мной рисунке?

Генерал, мне кажется, что ты ошибаешься с утверждением "перевести в 3D не представится сложным". Нахождение окружности, касающейся трех заданных, называется "задачей Апполония". Решение ее не очень простое, но существует. Но я не уверен, что оно есть для 3D. В 3D три заданных окружности превращаются в четыре заданных сферы..

Но дело даже не в этом. Боюсь, что даже найдя "сферу Апполония" (экстраполяция моя), задачу мы не решим..

P.S.
А куда исчезли мои предыдущие посты из этой темы?..

[GoodWind]

P.S.
А куда исчезли мои предыдущие посты из этой темы?..

почему-то скрыты...

Я тоже не понял почему. Если я что-то не так понял, модераторы поправлят снова.
Пока посты все опубликовал. Altair

Сообщение отредактировано: Altair - 24.04.2006 21:06

[klem4]

Я скрыл решение просто по тому что оно не верное, точнее не то я решал что нужно (в общем смысла в них не было), может и не стоило скрывать ...

Вот поправил ф-ю, теперь больше похоже на правду ... ждем тестовые данные ...

function GetRadius(s : TSArr) : word;
var
  i, j, p1, p2, L: word;
  maxL : integer;
begin
  maxL := -maxint;
  for i := 1 to n - 1 do
   for j := i + 1 to n do begin
     L := Len(s[i], s[j]) + s[i].r + s[j].r;
     if L >= maxL then begin
        maxL := L;
        p1 := i;
        p2 := j;
     end;
   end ;

   GetRadius := maxL;
end;

[bairt]

а ты можешь выложить результат?

[klem4]

а ты можешь выложить результат?

Извини, не понял тебя ...

[bairt]

я про данные она правильно работает? и ты можешь прислать решение я сравню его со своим...

[klem4]

Я же писал, у меня нету нормальных тестовых данных, сочинать их у меня нет ни малейшего желания, если у тебя они есть выложи их, кстате что тебе мешает самому проверить правильность моей программы ? Я не понимаю.

Сообщение отредактировано: klem4 - 26.04.2006 7:03

[Lapp]

Я скрыл решение просто по тому что оно не верное, точнее не то я решал что нужно (в общем смысла в них не было), может и не стоило скрывать ...
Вот поправил ф-ю, теперь больше похоже на правду ... ждем тестовые данные ...

klem4, ты не обратил внимания на пост Бравого генерала, а он дело говорил. Вот простой пример, опровергающий твое решение.

Код

Сфера 1:  x=-10  y=0   z=0  r=1
Сфера 2:  x=10   y=0   z=0  r=1
Сфера 3:  x=0    y=12  z=0  r=1

Твоя прога найдет 1 и 2 сферы, как наиболее удаленные, и проведет сферу радиусом 11 из начала координат. Сфера 3 в нее не попадет.

чтобы найти окружность, охватывающую множество точек, нужно найти две максимально удаленные точки M и N, найти еще одну точку, максимально удаленную от отрезка MN, и построить по этим трем точкам окружность.

Бравый генерал, я сначала пропустил это, а сейчас перечитал и увидел: твое утверждение неверно. Вот опровергающий пример.

Код

Точка 1 x=-100  y=0
Точка 2 x=100   y=0
Точка 3 x=0     y=150
Точка 4 x=95    y=-6

Точки 1 и 2 максимально удалены. Т 3 отстоит на максимальное растояние от отрезка 1-2. Окружность, проведенная через 1-2-3 оставит Т 4 снаружи.. (Извиняюсь за некрасивые числа - подбирал в уме)

Забегая вперед, скажу, что я, кажется, решил эту задачу.. Как только будет время - напишу сюда решение. Но только в общем виде, без программного кода..

PS
мужики (и дамы тоже!), давайте не прятать ничего и не скрывать. Дискуссия есть дискуссия. Возможны ошибки, возможны неверные рассуждения, неверные понимания - что ж с того? Но среди всего этого рождается Истина!