Вершины пирамиды Опции

[samec]

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

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

Сообщение отредактировано: samec - 10.11.2008 23:47

[Lapp]

Вот, кладу. Учти две вещи:
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.

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