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

[samec]

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

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

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

[samec]

вот сделал свою процедурку

{проверка введенных точек, на то, составляют ли они пирамиду или нет
 и если введенные точки составляют пирамиду, то функция возвращает номер точки,
 в массиве точек, являющейся верхушкой пирамиды}
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;

вроде работает