Доброе время суток всем. Проблемка такая: дано множество точек в пространстве. Каким образом можно проверить - будут ли эти точки являться вершинами пирамиды?
Добавлено через 4 мин.
понятно, что для существования пирамиды, необходимо, чтобы из n точек, n-1 лежало в одной плоскости, а одна точка была бы вне этой плоскости - но вот как выделить эту точку если такая существует?
можно и в алгоритмы.
Выше был, кто не догадался, я..
Вот, кладу. Учти две вещи:
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.
Спасибо большое!
Код хороший. Алгоритм я понял.
Что то мне подсказывает, что при количестве точек 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;
for i:=4 to n do if not Planar(i1,i2,i3,i) then begin
Inc(m);
i4:=i
end;
вот сделал свою процедурку
{проверка введенных точек, на то, составляют ли они пирамиду или нет
и если введенные точки составляют пирамиду, то функция возвращает номер точки,
в массиве точек, являющейся верхушкой пирамиды}
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;