Найти площадь пирамиды, требуется простенькое решение Опции

[Шушпанчик]

Вообщем задача сформулирована следующим образом:

"Написать программу нахождения площади поверхности пирамиды по координатам ее вершин. Подготовить и использовать процедуру определения площади треугольника по известным вершинам".

Задача простенькая с математической и логической т.з., но вот как её описывать в паскале - напрочь забыто.
Желательно использовать базовый инструментарий, такой как: линейные, разветвляющиеся и циклические алгоритмы, массивы, процедуры и функции.

Заранее большое человеческое спасибо! :p2:

[Amro]

А число вершин может быть любым??? т.е оно тоже задаётся?

[Amro]

Процедуру вычисления площади треугольника по координатам его вершин мона сделать так (используя формулу Герона):

Код

Procedure plosh (x1,y1,z1,x2,y2,z2,x3,y3,z3:real; var S:real;);
var
a,b,c,p:real
begin
    a:=sqrt(sqr(y2-y3)+sqr(x2-x3)+sqr(z2-z3));
    b:=sqrt(sqr(y1-y3)+sqr(x1-x3)+sqr(z1-z3));    
    c:=sqrt(sqr(y1-y2)+sqr(x1-x2)+sqr(z1-z2));
         p:=(a+b+c)/2;
    S:=p*sqrt((p-a)*(p-b)*(p-c));
end;

Если число вершин любое, тогда нужно находить всевозможные сочетания трёх вершин, посылать их координаты в процедуру и в основно части проги находить общую сумму!!!

Сообщение отредактировано: Amro - 19.10.2004 22:57

[GoodWind]

Amro, если не ошибаюсь, пирамида - трехмерный объект, следовательно

Код

a:=sqrt(sqr(y2-y3)+sqr(x2-x3)+sqr(z2-z3));

и т.д.

[Amro]

GoodWind Так точно!!!! ошибочка вышла ... щас исправим!!!

[GoodWind]

Так точно!!!!

ну не в армии же : )
а кол-во граней, если мне не изменяет склероз - (кол-во вершин-1)

[Amro]

GoodWind
В принципе кол-во граней в этой задаче не требуется

[GoodWind]

В принципе кол-во граней в этой задаче не требуется

площадь трехмерной фигуры - сумма площадей всех её граней, значит для пирамиды это сумма площадей всех боковых граней + площадь дна

[Amro]

площадь трехмерной фигуры - сумма площадей всех её граней, значит для пирамиды это сумма площадей всех боковых граней + площадь дна

Ну это само собой!!!
Просто я о чём хочу сказать?! Любую грань составляют три вершины пирамиды, если пирамида неправильная то площади граней разные! О дне: дно также можно разбить на треугольники, типа на мнимые грани .... т.е нам необходимо найти всевозможные сочетания вершин, как я уже писал, а площадь дна будет равна сумме площадей её составляющих треугольников к примеру
у нас вершины
А Б В Г Д Е Ж
сочетания (ну это уже комбинаторика попёрла)
АБВ БВГ ВГД ЕЖА ЕДГ и т.д это треугольники сумма площадей которых и есть площадь пирамиды...............
Теперь как это реализовать???

[GoodWind]

Любую грань составляют три вершины пирамиды, если пирамида неправильная то площади граней разные!

да, мой косяк...мне на ночь глядя показалось, что пирамида обязательно равнобедренная надо больше спать

О дне: дно также можно разбить на треугольники,

не можно, а в любом случае придется....

Теперь как это реализовать???

завтра подумаю, щас туплю уже...

ээх.... надо было в школе стереометрию не прогуливать

[Amro]

Ещё одно но о том же дне ... там мадо найти тоже определенные треугольники, т.е какие то сочетания вершин надо исключить, а то дно получится как паутина!!!!

[GoodWind]

я думаю делить на две части, и каждую часть на 2 части, пока все вершины не окажутся задействованы.

сам прочитал, ниче не понял главно идея есть...

усё, спать пошел...

[Guest]

Ладно, делать нечего, придётся ради сохранения собственных нервных клеток сокращать сущности, а то так придётся из примитивной курсовой диссертацию писать. ;)

Вообщем попробуем сузить круг условий: пирамида имеет пять вершин.

Но и тогда у меня возникают непонятки.
Во-первых, если измерять площадь всех сочетаний, то тогда, как правильно сказал Amro, возникает перебор с количеством необходимых площадей. Как реализовывать правильную калькуляцию площадей краней?
Во-вторых, как реализовывать выбор вершины, которая не лежит в основании. Наверное придётся тупо указывать z[2-4] значение, равное z[1].

Ну и вот собсно половина кода. Вторую половину, а именно как подсчитывать площадь я не знаю. Может подскажите?

Код

Var S: real;
               x: Array [1..5] of Real;
               y: Array [1..5] of Real;
               z: Array [1..5] of Real;
           i,n,m: Integer;

{процедура вычисления площади треугольника}
procedure plosh(x_1,y_1,z_1,x_2,y_2,z_2,x_3,y_3,z_3:real);
var
a,b,c,p,t:real;
begin
 a:=sqrt(sqr(y_2-y_3)+sqr(x_2-x_3)+sqr(z_2-z_3));
 b:=sqrt(sqr(y_1-y_3)+sqr(x_1-x_3)+sqr(z_1-z_3));
 c:=sqrt(sqr(y_1-y_2)+sqr(x_1-x_2)+sqr(z_1-z_2));
 p:=(a+b+c)/2;
 t:=p*sqrt((p-a)*(p-b)*(p-c));
end;

{заносим в массив координаты вершин}
for i:=1 to 5 do
begin
 if i:=1 or 5 then
  begin
   write('X',i,' -> '); readln(x[i]);
   write('Y',i,' -> '); readln(y[i]);
   write('Z',i,' -> '); readln(z[i]);
  end;
 else
  begin
   write('X',i,' -> '); readln(x[i]);
   write('Y',i,' -> '); readln(y[i]);
   z[i]:=z[1]
   writeln;
  end;
 end;
end;
{начинаем перебор всех вариантов сочетания вершин, создающих треугольник}
for i:=1 to 5 do
for n:=1 to 5 do
for m:=1 to 5 do
begin
 if ((i<>n) and ((n<>m) and (i<>m))) then
 begin
plosh(x[i],y[i],z[i],x[n],y[n],z[n],x[m],y[m],z[m]);
 end;
end;

[volvo]

Теперь как это реализовать???

Вот так:

программа вычисляет площадь пирамиды при любом числе точек в основании (только для выпуклого основания; для невыпуклого - нужно проводить триангуляцию...)

Код

Const
 { Это число точек в основании }
 basisPoints = 4;
 Epsilon = 0.0001;

Type
 { Описываем тип Точка - с тремя координатами }
 TAxis = (axisX, axisY, axisZ);
 TPoint =
   Record
     Case Boolean Of
       True : (x, y, z: Real);
       False: (arr: Array[TAxis] Of Real);
   End;

 { и тип Пирамида - с основанием (basis) и отдельной точкой (other)}
 TPyramide =
   Record
     basis: Array[1 .. basisPoints] Of TPoint;
     other: TPoint;
   End;


Var
 pyramide: TPyramide;


{ Площадь треугольника вычисляем по формуле Герона,
 но сам треугольник задаем не отдельными координатами,
 а вершинами }
Function Plosh(p1, p2, p3: TPoint): Real;
 Var
   a, b, c, p: Real;
 Begin
   a:=sqrt(sqr(p2.y-p3.y)+sqr(p2.x-p3.x)+sqr(p2.z-p3.z));
   b:=sqrt(sqr(p1.y-p3.y)+sqr(p1.x-p3.x)+sqr(p1.z-p3.z));
   c:=sqrt(sqr(p1.y-p2.y)+sqr(p1.x-p2.x)+sqr(p1.z-p2.z));
   p:=(a + b + c)/2;
   Plosh := Sqrt(p*(p-a)*(p-b)*(p-c))
 End;


Procedure SwapReal( Var a, b: Real );
 Var T: Real;
 Begin
   T := a; a := b; b := T;
 End;

Procedure SwapInt( Var a, b: Integer );
 Var T: Integer;
 Begin
   T := a; a := b; b := T;
 End;

{ Эта процедура распределяет номера вершинам основания }
Procedure CheckPolygon;

 Function isAxisEqual(axis: TAxis): Boolean;
   Var
     i: Integer;
     value: Real;
   Begin
     isAxisEqual := False;
     value := pyramide.basis[1].arr[axis];
     For i := 2 To basisPoints Do
       If Abs(pyramide.basis[i].arr[axis] - value) > Epsilon
         Then Exit;
     isAxisEqual := True;
   End;

 Var
   mainAxisX, mainAxisY: TAxis;

   angle: Array[1 .. basisPoints] Of Real;
   DynamicArr: Array[1 .. basisPoints] Of TPoint;
   indexes: Array[1 .. basisPoints] Of Integer;
   max, minX: Real; i, j, maxIndex, minIndex: Integer;
   changed: Boolean;

 Begin
   MainAxisX := axisX; MainAxisY := axisY;

   If isAxisEqual( axisY ) Then
     MainAxisY := AxisZ
   Else
     If isAxisEqual( axisX ) Then
       Begin
         MainAxisX := axisY; MainAxisY := axisZ;
       End;

   minX := maxInt;
   For i := 1 To basisPoints Do
     If minX > pyramide.basis[i].X Then
       Begin
         minX := pyramide.basis[i].X; minIndex := i
       End;

   indexes[1] := minIndex; j := 0;
   For i := 2 To basisPoints Do
     Begin
       Inc(j);
       If j = minIndex Then
         Inc(j);
       indexes[i] := j;
     End;

   For i := 1 To basisPoints Do
     If i <> minIndex Then
       Begin
         If (pyramide.basis[i].arr[mainAxisY] - pyramide.basis[minIndex].arr[MainAxisY]) = 0
           Then angle[i] := 0
           Else angle[i] :=
             ArcTan((pyramide.basis[i].arr[MainAxisX]-pyramide.basis[minIndex].arr[MainAxisX])/
                    (pyramide.basis[i].arr[MainAxisY]-pyramide.basis[minIndex].arr[MainAxisY]))*
                              (180 / Pi);
       End;

   For i := 2 To basisPoints Do
     Begin
       changed := False;
       max := angle[i];
       For j := i To basisPoints Do
         If max < angle[j] Then
           Begin
             max := angle[j];
             maxIndex := j;
             changed := True;
           End;
       If changed Then
         Begin
           SwapInt(indexes[maxIndex], indexes[i]);
           SwapReal(angle[maxIndex], angle[i])
         End;
     End;

   For i := 1 To basisPoints Do
     Move( pyramide.basis[ indexes[i] ], DynamicArr[i], SizeOf(TPoint) );
   Move( DynamicArr, pyramide.basis, basisPoints*SizeOf(TPoint) );
 End;



Var
 s: Real;
 i, j: Integer;

Begin
 { заносим в массив координаты вершин основания пирамиды }
 For i := 1 To basisPoints Do
   With pyramide.basis[i] Do
     Begin
       WriteLn( 'Вершина основания #', i );
       Write( 'X = ' ); ReadLn(X);
       Write( 'Y = ' ); ReadLn(Y);
       Write( 'Z = ' ); ReadLn(Z);
     End;

 WriteLn( 'Верхняя точка пирамиды:' );
 With pyramide.other Do
   Begin
     Write( 'X = ' ); ReadLn(X);
     Write( 'Y = ' ); ReadLn(Y);
     Write( 'Z = ' ); ReadLn(Z);
   End;

 { Устанавливает порядок прохождения вершин основания }
 CheckPolygon;

 s := 0;
 For i := 1 To basisPoints Do
   With pyramide Do
     Begin
       { считаем сумму площадей боковых граней }
       If i <> basisPoints Then j := Succ(i) Else j := 1;
       s := s + Plosh(basis[i], basis[j], other);

     End;

 { Этот способ нахождения площади основания - для тех оснований, которые являются выпуклыми многоугольниками из basisPoints вершин }
 For i := 2 To Pred(basisPoints) Do
   s := s + Plosh(pyramide.basis[1], pyramide.basis[i], pyramide.basis[Succ(i)]);

 WriteLn( 'Площадь пирамиды s = ', s:10:3 )

End.

[Guest]

Вообщем вот полный код.
Проблема в одном : после процедуры в значениях выходят нули.

var 
  x: Array [1..5] of Real;
  y: Array [1..5] of Real;
  z: Array [1..5] of Real;

{ Площадь треугольника вычисляем по формуле Герона,
 но сам треугольник задаем не отдельными координатами,
 а вершинами }

Function Plosh(x1, y1, z1, x2, y2, z2, x3, y3, z3: TPoint): Real;
 Var
   a, b, c, p: Real;
 Begin
   a:=sqrt(sqr(y2-y3)+sqr(x2-x3)+sqr(z2-z3));
   b:=sqrt(sqr(y1-y3)+sqr(x1-x3)+sqr(z1-z3));
   c:=sqrt(sqr(y1-y2)+sqr(x1-x2)+sqr(z1-z2));
   p:=(a + b + c)/2;
   Plosh := p * Sqrt((p-a)*(p-B)*(p-c))
 End;

Var
 s: Real;
 i, j: Integer;
 pyramide: TPyramide;

Begin
 { заносим в массив координаты вершин основания пирамиды }
 For i := 1 To 4 Do
     Begin
      if i:=1 then  
       WriteLn( 'Вершина основания ', i );
       Write( 'X = ' ); ReadLn(X[i]);
       Write( 'Y = ' ); ReadLn(Y[i]);
       Write( 'Z = ' ); ReadLn(Z[i]);
     else
       WriteLn( 'Вершина основания ', i );
       Write( 'X = ' ); ReadLn(X[i]);
       Write( 'Y = ' ); ReadLn(Y[i]);
       z[i]:=z[1];
     End;



 WriteLn( 'Верхняя точка пирамиды:' );
   Begin
     Write( 'X = ' ); ReadLn(X[5]);
     Write( 'Y = ' ); ReadLn(Y[5]);
     Write( 'Z = ' ); ReadLn(Z[5]);
   End;

 s := 0;
 For i := 1 To 4 Do
     Begin
       { считаем сумму площадей боковых граней }
       If i <> 4 Then j := Succ(i) Else j := 1;
       s := s + Plosh(x[i], y[i], z[i], x[j], y[j], z[j], x[5], y[5], z[5]);
     End;

 s := s + Plosh(x[1], y[1], z[1], x[2], y[2], z[2], x[3], y[3], z[3]);
 s := s + Plosh(x[2], y[2], z[2], x[3], y[3], z[3], x[4], y[4], z[4]);

 WriteLn( 'Площадь пирамиды s = ', s )

End.

[volvo]

можешь дать мне координаты всех вершин ?

[zx1024]

s := s + Plosh(x[1], y[1], z[1], x[2], y[2], z[2], x[3], y[3], z[3]);
s := s + Plosh(x[2], y[2], z[2], x[3], y[3], z[3], x[4], y[4], z[4]);

Это не площадь 4-угольника.

s := s + Plosh(x[1], y[1], z[1], x[2], y[2], z[2], x[3], y[3], z[3]);
s := s + Plosh(x[1], y[1], z[1], x[3], y[3], z[3], x[4], y[4], z[4]);

- вот это больше похоже.

[zx1024]

После минутных размышлений...
Не всегда можно сразу сказать как расположены 4 точки (из 3D) на плоскости, которая по ним строится. Поэтому сначала надо составить из 4 точек два непересекающихся треугольника.

[Atos]

Была недавно в чём-то похожая тема http://pascal.net.ru/forum/index.php?showtopic=2717
А вообще-то в чём здесь проблема? Можно вычислять площадь опнования так:
выделить первую же точку, а затем суммировать площади треугольников, получающихся перебором остальных вершин. То есть одной из вершин всех треугольников будет выбранная точка, другой - i-я точка, третьей - (i+1)я точка . И увеличиваем i от 2 до (basicPoints-1)

[volvo]

Так в случае выпуклого основания проблемы нет. А вот если многоугольник в основании НЕвыпуклый -

А может быть в основании пирамиды может быть только выпуклый многоугольник?

Сообщение отредактировано: volvo - 20.10.2004 19:01