IPB
ЛогинПароль:

 
 Ответить  Открыть новую тему 
> Вершины пирамиды
сообщение
Сообщение #1


Бывалый
***

Группа: Пользователи
Сообщений: 180
Пол: Мужской
Реальное имя: Юра

Репутация: -  1  +


Доброе время суток всем. Проблемка такая: дано множество точек в пространстве. Каким образом можно проверить - будут ли эти точки являться вершинами пирамиды?

Добавлено через 4 мин.
понятно, что для существования пирамиды, необходимо, чтобы из n точек, n-1 лежало в одной плоскости, а одна точка была бы вне этой плоскости - но вот как выделить эту точку если такая существует?

Сообщение отредактировано: samec -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(samec @ 10.11.2008 23:41) *
необходимо, чтобы из n точек, n-1 лежало в одной плоскости, а одна точка была бы вне этой плоскости - но вот как выделить эту точку если такая существует?

Процесс долгий и нудный, а главное - к математике не имеет особого отношения.. smile.gif Последовательная проверка условий по принадлежности точек плоскостям (если в конечном итоге имеется в виду программа, то нужно предусмотреть такую функцию).
Перенести тему в Алгоритмы? Там можно набросать блок-схемку..




--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Бывалый
***

Группа: Пользователи
Сообщений: 180
Пол: Мужской
Реальное имя: Юра

Репутация: -  1  +


можно и в алгоритмы.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Цитата(samec @ 11.11.2008 6:49) *
можно и в алгоритмы.
Okay, переношу.

Я начал было рисовать блок-схемку, но под рукой не оказалось ничего удобного для рисования. Зато FP всегда рядом, так что я просто настрочил прогу. Нужна она тебе? Выложить?..
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Выше был, кто не догадался, я.. smile.gif


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Бывалый
***

Группа: Пользователи
Сообщений: 180
Пол: Мужской
Реальное имя: Юра

Репутация: -  1  +


Цитата(Гость @ 11.11.2008 14:00) *

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


Буду премного благодарен smile.gif

оффтоп: а если тема перенесена - то почему она теперь и в Алгоритмах и в Математике есть? Или это у меня в глазах двоится? smile.gif

Сообщение отредактировано: samec -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Вот, кладу. Учти две вещи:
1. Нужно дописать проверку на то, что 3 точки расположены по одной линии, и на то, что 4 точки лежат в одной плоскости (рыбы для функций есть).
2. Поскольку функций для проперки у меня не было, полноценное тестирование я провести не мог - могут быть ошибки.
const
n=8; // Number of points

type
tPoint= record
x,y,z: real
end;

var
a: array[1..n]of tPoint;

function Linear(i,j,k:integer):boolean;
begin
// Here, insert test for linearity of 3 points
end;

function Planar(i,j,k,l:integer):boolean;
begin
// Here, test for planarity of 4 points
end;

procedure Exchange(i,j:integer);
var
b: tPoint;
begin
b:=a[i];
a[i]:=a[j];
a[j]:=b
end;

var
i,i1,i2,i3,i4,i30,Pass,m: integer;

begin
Pass:=1;
repeat
i1:=1;
i2:=2;
i3:=3;
while (i3<=n) and (i3<>i1) and (i3<>i2) and Linear(i1,i2,i3) do Inc(i3);
if i3>n then begin
WriteLn('All points are in one line');
Exit
end;
if Pass=1 then begin
Exchange(3,i3);
i30:=i3;
i3:=3
end;
m:=0;
for i:=4 to n do if not Planar(i1,i2,i3,i) then begin
Inc(m);
i4:=i
end;
if m=0 then begin
WriteLn('All points are in one plane');
Exit
end
else if m=1 then begin
if Pass=2 then begin
Exchange(1,4);
Exchange(2,5);
Exchange(3,6);
if i4<=6 then Dec(i4,3)
end;
Exchange(i30,3);
if i4=i30 then i4:=3;
WriteLn('The top is #',i4)
end
else if Pass=2 then WriteLn('Not a piramid')
else begin
Exchange(1,4);
Exchange(2,5);
Exchange(3,6)
end;
Inc(Pass)
until Pass=3
end.


По поводу раздваивания: главное не расстраиваться smile.gif.
В старом разделе остается сслыка на эту тему. Я их оставляю, чтоб проще было найти в первое время. Потом удаляю (если не забываю smile.gif).


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Бывалый
***

Группа: Пользователи
Сообщений: 180
Пол: Мужской
Реальное имя: Юра

Репутация: -  1  +


Спасибо большое!
Код хороший. Алгоритм я понял.
Что то мне подсказывает, что при количестве точек 5 (n=5) написанный код может не сработать.
Ведь если в первом проходе (Pass=1) в любую из точек попадает вершина, то вот в этом моменте:

if m=0 then begin
WriteLn('All points are in one plane');
Exit
end
else if m=1 then begin
if Pass=2 then begin
Exchange(1,4);
Exchange(2,5);
Exchange(3,6);
if i4<=6 then Dec(i4,3)
end;
Exchange(i30,3);
if i4=i30 then i4:=3;
WriteLn('The top is #',i4)
end
else if Pass=2 then WriteLn('Not a piramid')
else begin
Exchange(1,4);
Exchange(2,5);
Exchange(3,6) { <- вот тут}
end;


мы поменяем точку на что то неправильное (ведь всего их пять).

Сообщение отредактировано: samec -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(samec @ 12.11.2008 23:47) *
Что то мне подсказывает, что при количестве точек 5 (n=5) написанный код может не сработать.

Да, верно, я планировал написать об этом в примечаниях, но забыл sad.gif. То же самое для четырех.
Надо подумать, как исправить.


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Бывалый
***

Группа: Пользователи
Сообщений: 180
Пол: Мужской
Реальное имя: Юра

Репутация: -  1  +


Цитата(Lapp @ 13.11.2008 3:52) *

То же самое для четырех.

а вот для 4-х помоему всё ок. Ведь если будет 4-е вершины, то до этого места не дойдёт
ведь в цикле:

for i:=4 to n do if not Planar(i1,i2,i3,i) then begin
Inc(m);
i4:=i
end;


переменная m - либо увеличится на единицу (если точки составляют вершины пирамиды) либо не увеличится (если все точки лежат в одной плоскости).
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Бывалый
***

Группа: Пользователи
Сообщений: 180
Пол: Мужской
Реальное имя: Юра

Репутация: -  1  +


вот сделал свою процедуркуsmile.gif
{проверка введенных точек, на то, составляют ли они пирамиду или нет
и если введенные точки составляют пирамиду, то функция возвращает номер точки,
в массиве точек, являющейся верхушкой пирамиды}
function Proverka:integer;
var
i,j,k,l:integer; {счетчики циклов}
i2,{точка вершины пирамиды}
n,{количиество точек}
m: integer; {вспомогательная переменная}
flag:boolean; {флаг}
begin
n:=kol; {количество введенных точек}
{проверяем, не лежат ли любые три точки (из всех введенных) на одной прямой}
{перебор всех троек точек в массиве точек}
for i:=1 to n do
for j:=i+1 to n do
for k:=j+1 to n do
{если три точки лежат на однй прямой, то}
if Linear(i,j,k) then
begin {если любые три точки лежат на одной прямой, выводим сообщение}
OutPoint(arPoint[i],''); {вывод точки на экран}
OutPoint(arPoint[j],'');
OutPoint(arPoint[k],'');
WriteLn('лежат на одной прямой!');
Proverka:=0;
Exit {выход из процедуры проверки}
end;
{если точек всего 4 - то проверяем, не лежат ли они в одной плоскости}
if(n=4) then
if Planar(1,2,3,4) then
begin {лежат в одной плоскости}
OutPoint(arPoint[1],'');
OutPoint(arPoint[2],'');
OutPoint(arPoint[3],'');
OutPoint(arPoint[4],'');
WriteLn('лежат в одной плоскости!');
Proverka:=0;
Exit {выход из процедуры проверки}
end
else
begin {не лежат в одной плоскости}
WriteLn('Верхушка пирамиды находится в точке 1');
Proverka:=1;
Exit; {выход из процедуры проверки}
end;
{если точек более чем 4}
{находим любые 4 точки в массиве точек, которые лежат в одной плоскости}
flag:=false;
for i:=1 to n do
begin
for j:=i+1 to n do
begin
for k:=j+1 to n do
begin
for l:=l+1 to n do
begin
flag:=Planar(i,j,k,l);
if(flag) then Break;
end; {end for l}
if(flag) then Break;
end; {end for k}
if(flag) then Break;
end; {end for i}
if(flag) then Break;
end; {end for i}
{если не найдено четырех точек лежащих в одной плоскости}
if not flag then
begin
WriteLn('Из введенных ',n,' точек не найдено ',n-1,' точек лежащих в одной плоскости');
Proverka:=0;
Exit; {выход из процедуры проверки}
end;
m:=0; {количество точек, не лежащих в одной плоскости
с точками найденными на пердыдущем шаге.
Для существования пирамиды m должно быть = 1}
for i:=1 to n do
if not Planar(j,k,l,i) then
begin {если такая точка нашлась}
Inc(m); {увеличиваем счетчик точек}
i2:=i; {запоминаем, какая это точка}
end;
{если все точки лежат в одной плоскости (m=0), то выводим соответствующее сообщение}
if m=0 then
begin
WriteLn('Все точки лежат в одной плоскости!');
Proverka:=0;
Exit;
end
else
if m=1 then {если все точки кроме одной (m=1) лежат в одной плоскости}
begin
WriteLn('Верхушка пирамиды находится в точке ',i2);
Proverka:=i2;
Exit;
end
else {если точек, не лежащих в одной плоскости
с точками найденными на пердыдущем шаге больше чем 1, то}
begin
WriteLn('Из введенных ',n,' точек не найдено ',n-1,' точек лежащих в одной плоскости');
Proverka:=0;
end;
end;



вроде работает smile.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 27.10.2020 22:10
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name