Pyramid

Author

Eric W. Weisstein
October 16, 2023

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Polyhedra/Pyramid.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Pyramid.html.

©2023 Wolfram Research, Inc. except for portions noted otherwise

Graphics

PolyhedronData equilateral

PolyhedronData["Pyramid*"]

Table[PolyhedronData[{"Pyramid",n}],{n,3,5}]

RegularRightPyramid[3]

RegularRightPyramid[3]//PolyhedronEdgeLengths

RegularRightPyramid[5]//PolyhedronEdgeLengths//FullSimplify

GraphicsRow[Table[Graphics3D[{Opacity[.4],RegularRightPyramid[n]},Boxed->False],{n,3,5}],Alignment->Bottom,ImageSize->500,Spacings->-50]

Equilateral duals

PolyhedronData[{"Pyramid",4},"Dual","Name"]

PolyhedronData[{"Pyramid",4},"Dual","Scale"]

Midsphere[PolyhedronData[{"Pyramid",4},"Polyhedron"]]

Graphics3D[{Opacity[.5],
{Green,PolyhedronData[{"Pyramid",4},"Polyhedron"]},
{Red,PolyhedronData[{"Pyramid",4},"Polyhedron"]/.Polyhedron[v_,f_]:>Polyhedron[{1,1,-1}#&/@v,f]},
{Yellow,PolyhedronData[{"Pyramid",4},"Midsphere"],Sphere[{0,0,-(Sqrt[2])},(3/2)]}},Boxed->False]

PolyhedronData[{"Pyramid",4},"Centroid"]

Graphics3D[{Opacity[.5],
{Green,PolyhedronData[{"Pyramid",4},"Polyhedron"]},
{Red,PolyhedronData[{"Pyramid",4},"Polyhedron"]/.Polyhedron[v_,f_]:>Polyhedron[({0,0,1/(4 Sqrt[2])}+{1,1,-1}#)&/@v,f]},
{Yellow,PolyhedronData[{"Pyramid",4},"Midsphere"]}},Boxed->False]

PolyhedronData canonical

GraphicsRow[Table[Graphics3D[{Opacity[.3],CanonicalPyramid[n]},Boxed->False,Method->{"ShrinkWrap"->True}],{n,3,7}],Spacings->70,Alignment->Bottom,PlotRangePadding->{Automatic,-500},ImageSize->500]

GraphicsRow[Table[Graphics3D[{Opacity[.3],PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"]},Boxed->False,Method->{"ShrinkWrap"->True},ViewPoint->{.3,2,.2}],{n,3,7}],Spacings->70]

Canonical with duals

GraphicsRow[Table[Graphics3D[{Opacity[.5],
Red,PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"],
Yellow,PolyhedronData[{"CanonicalPyramid",n},"Midsphere"],
Green,PolyhedronData[{"CanonicalPyramid",n},"Dual","Polyhedron"]},Boxed->False,Method->{"ShrinkWrap"->True}],{n,3,6}],Spacings->100]

Prisms.m

Table[Graphics3D@MyPolyhedron[MyPyramid[n]],{n,3,8}]

Nets

GraphicsGrid[Partition[Table[PolyhedronData[{"CanonicalPyramid",n},"Net"],{n,3,10}],4]]

Wireframe

Square-Base

Show[Graphics3D[Pyramid[4,1]],Boxed->False,ViewPoint->2{1,1,.7}]

Show[Graphics[HiddenWireframe[Pyramid[4,1],ViewPoint->2{1,1,.7}]],AspectRatio->Automatic]

{"Pyramid", n}

<<MathWorld`PolyhedronOperations`

p=PolyhedronData[pname={"Pyramid",n},"Polyhedron"];

EdgeLengths

FullSimplify[Table[Sqrt[h^2+a^2 Csc[Pi/n]^2/4],{n,3,6}]]

MeanCylindricalRadius

Table[((NIntegrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"])),{n,3,5}]

(i=Block[{n=3},((Integrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))])//Timing

(i=Block[{n=4},((Integrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))])//Timing

(i=Block[{n=5},((Integrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))])//Timing

MeanCylindricalSquareRadius

(data=Table[{n,Sequence@@Timing[((Integrate[(x^2)+(y^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))]},{n,3,5}]//FullSimplify)//Timing

TextGrid[data,Dividers->All]

MeanSphericalRadius

(i=((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"])))//Timing

N[i]

MeanSphericalSquareRadius

(data=Table[{n,Sequence@@Timing[((Integrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))]},{n,3,5}]//FullSimplify)//Timing

TextGrid[data,Dividers->All]

SlantHeight

FullSimplify[Table[Sqrt[h^2+a^2 Cot[Pi/n]^2/4],{n,3,6}]]

SurfaceArea

n a^2 Cot[Pi/n]/4+1/2(n a)Sqrt[h^2+a^2 Cot[Pi/n]^2/4]

s=FullSimplify[%]

Volume

(1/12)n Cot[(π/n)](a^(2 ))h/.a->2R Sin[(π/n)]//Simplify

%/.Sin[x_]:>Sinc[x]x

Tetrahedron Check

FullSimplify[s/.{n->3,h->Sqrt[6]a/3},a>0]

Properties: "Pyramid"

{"Pyramid", 3}

PolyhedronData[{"Pyramid",3},"StandardName"]

Circumsphere

PolyhedronData[{"Pyramid",3},"Circumsphere"]

Norm/@PolyhedronData[{"Pyramid",3},"VertexCoordinates"]//FullSimplify//Union

Dual

PolyhedronData[{"Pyramid",3},"Dual",#]&/@{"Name","Scale"}

With[{p={"Pyramid",3}},{
Graphics3D[{{Opacity[1],MapIndexed[Text[#2[[1]],#,Background->White]&,v1=PolyhedronData[p,"VertexCoordinates"]]},
Red,PolyhedronData[p,"Polyhedron"]},Axes->True],
Graphics3D[{{Opacity[1],MapIndexed[Text[#2[[1]],#,Background->White]&,v2=PolyhedronData[p,"Dual","Polyhedron"][[1]]]},Green,PolyhedronData[p,"Dual","Polyhedron"]},Axes->True]
}]

both=Graphics3D[{Opacity[.3],First/@%},Boxed->False]

Insphere

PolyhedronData[{"Pyramid",3},"Insphere"]

PolyhedronData[{"Pyramid",3},"Polygons"]/.Polygon[l_]:>Norm[Mean[l]]//FullSimplify//Union

Midsphere

PolyhedronData[{"Pyramid",3},"Midsphere"]

PolyhedronData[{"Pyramid",3},"Lines"]/.Line[l_]:>Norm[Mean[l]]//Union

With[{p={"Pyramid",3}},Graphics3D[{Red,PolyhedronData[p,"Midsphere"],Opacity[.5],
{Green,PolyhedronData[p,"Dual","GraphicsComplex"]},
{Blue,PolyhedronData[p,"GraphicsComplex"]}},Boxed->False,Method->{"ShrinkWrap"->True}]]

{"Pyramid", 4}

Initialization

p=PolyhedronData[pname={"Pyramid",4},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

Circumsphere

PolyhedronData[{"Pyramid",4},"Circumsphere"]

Norm/@PolyhedronData[{"Pyramid",4},"VertexCoordinates"]//FullSimplify//Union

Dual

PolyhedronData[{"Pyramid",4},"Dual",#]&/@{"Name","Scale"}

With[{p=PolyhedronData[{"Pyramid",4},"Polyhedron"]},Graphics3D[{Opacity[.5],Red,p,Green,DualPolyhedron[p]}]]

With[{p={"Pyramid",4}},{
Graphics3D[{{Opacity[1],MapIndexed[Text[#2[[1]],#,Background->White]&,v1=PolyhedronData[p,"VertexCoordinates"]]},
Red,PolyhedronData[p,"Polyhedron"]},Axes->True],
Graphics3D[{{Opacity[1],MapIndexed[Text[#2[[1]],#,Background->White]&,v2=PolyhedronData[p,"Dual","Polyhedron"][[1]]]},Green,PolyhedronData[p,"Dual","Polyhedron"]},Axes->True]
}]

both=Graphics3D[{Opacity[.3],First/@%},Boxed->False]

Insphere

PolyhedronData[{"Pyramid",4},"Insphere"]

PolyhedronData[{"Pyramid",4},"Polygons"]/.Polygon[l_]:>Norm[Mean[l]]//FullSimplify//Union

MeanCylindricalRadius

PolyhedronData[{"Pyramid",4},"MeanCylindricalRadius"]

((NIntegrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/vol)//Timing

Integrate over polyhedron [unevaluated]

$Version

(rxy=((Integrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/vol))//Timing

Divergence theorem

(rxy=MeanCylindricalRadius[p,Debug->True])//Timing

FullSimplify[rxy]

Integrate using Boole

ineq=PolyhedronData[pname,"RegionFunction"][x,y,z]//FullSimplify

MaxValue[{#,ineq},{x,y,z}]&/@{x,y,z}

((8NIntegrate[(Sqrt[(x^2)+(y^2)])Boole[ineq],{x,0,(2^(-1/2))},{y,0,x},{z,0,(2^(-1/2))}])/(PolyhedronData[pname,"Volume"]))

(i1=Assuming[0<y<x<(2^(-1/2)),FullSimplify[Integrate[(Sqrt[(x^2)+(y^2)])Boole[ineq],{z,0,(2^(-1/2))}]]])//Timing

(i2=Assuming[0<x<(2^(-1/2)),FullSimplify[Integrate[i1,{y,0,x}]]])//Timing

((8NIntegrate[i2,{x,0,(2^(-1/2))}])/(PolyhedronData[pname,"Volume"]))

i3=FullSimplify[Integrate[i2,{x,0,(2^(-1/2))}]]

((8i3)/(PolyhedronData[pname,"Volume"]))//FullSimplify

FactorInteger[32768]

((48+6 (5+4 (Sqrt[2])) ArcSinh[1]+15Log[2]-30 Log[2+(Sqrt[2])])/(192 (Sqrt[2])))//FullSimplify

N[%]

(((1+(Sqrt[2])))^n)==577+408 (Sqrt[2])

n Log[1+(Sqrt[2])]==Log[577+408 (Sqrt[2])]

((Log[577+408 (Sqrt[2])])/(Log[1+(Sqrt[2])]))//FullSimplify

FullSimplify[(1/64) (8 (Sqrt[2])+8Log[1+(Sqrt[2])])]

N[%]

MeanSphericalRadius

PolyhedronData[{"Pyramid",4},"MeanSphericalRadius"]

((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈p])/vol)//Timing

Integrate over polyhedron

((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈p])/vol)//Timing

(rxyz=MeanSphericalRadius[p,Debug->True])//Timing

Boole

ineq=PolyhedronData[pname,"RegionFunction"][x,y,z]//FullSimplify

MaxValue[{#,ineq},{x,y,z}]&/@{x,y,z}

((8NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[ineq],{x,0,(2^(-1/2))},{y,0,x},{z,0,(2^(-1/2))}])/(PolyhedronData[pname,"Volume"]))

(i1=Assuming[0<y<x<(2^(-1/2)),FullSimplify[Integrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[ineq],{z,0,(2^(-1/2))}]]])//Timing

(i2=Assuming[0<x<(2^(-1/2)),FullSimplify[Integrate[i1,{y,0,x}]]])//Timing

((8NIntegrate[i2,{x,0,(2^(-1/2))}])/(PolyhedronData[pname,"Volume"]))

i3=FullSimplify[Integrate[i2,{x,0,(2^(-1/2))}]]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

((NIntegrate[(x^2)+(y^2),{x,y,z}∈p])/vol)//Timing

Integrate

(i=((Integrate[(x^2)+(y^2),{x,y,z}∈p])/vol))//Timing

Divergence theorem

(rxy=MeanSquareCylindricalRadius[p])//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

((NIntegrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/vol)//Timing

Integrate

(i=((Integrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/vol))//Timing

Divergence theorem

(rxy=MeanSquareSphericalRadius[p])//Timing

Midsphere

PolyhedronData[{"Pyramid",4},"Midsphere"]

{"Pyramid", 5}

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"Pyramid",5},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

Graphics3D[{AbsolutePointSize[10],
Point[{0,0,0}],{Blue,Point[PolyhedronData[pname,"Centroid"]]},Opacity[.2],PolyhedronData[pname,"GraphicsComplex"]}]

(xbar1=RegionCentroid[p]//FullSimplify)//Timing

(xbar2=PolyhedronCentroid[p]//FullSimplify)//Timing

xbar1==xbar2//FullSimplify

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

sphere=Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

Graphics3D[{{Opacity[.2],Yellow,sphere},p},Boxed->False]

Compound

PolyhedronData[pname,"Compound"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]//Tally

SimplifyNumericallyDistinct[DihedralAngles[p]]//Tally

EdgeCount

PolyhedronData[pname,"EdgeCount"]

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

PolyhedronData[pname,"Lines"]/.Line[l_]:>EuclideanDistance@@l//FullSimplify//Union//Quiet

lens=SimplifyNumericallyDistinct[PolyhedronEdgeLengths[p]];//Quiet

(distinctlens=Mean/@Split[Sort[lens],Abs[#1-#2]<1.*^-10&])//N//Quiet

v=PolyhedronCoordinates[p];

colors=With[{n=Length[distinctlens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[distinctlens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[p],Boxed->False]//Quiet

FaceCount

PolyhedronData[pname,"FaceCount"]

Faces

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

%==%%//FullSimplify

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i=((MomentOfInertia[p,{0,0,0}])/(Volume[p]))//FullSimplify)//Timing

PolyhedronInertiaTensor[p]//Timing

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]//FullSimplify

(sphere=MyInsphere[p,Debug->True,"Simplification"->(FullSimplify[RootReduce[#]]&)]//RootReduce//FullSimplify)//Timing

Graphics3D[{{Opacity[.5],p},{Red,#}},Boxed->False]&/@sphere

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

N[%]

((NIntegrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))//Timing

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=MinMax/@Transpose[PolyhedronCoordinates[p]]

ineq=PolyhedronData[pname,"RegionFunction"][x,y,z]

(i1=Integrate[Boole[ineq](Sqrt[(x^2)+(y^2)]),{z,zmin,zmax}]/.p_Piecewise:>RootReduce/@p)//Timing

NIntegrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}]//Timing

(i2=Integrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}])//Timing

N[i2,10]

RootReduce[i2]

(i22=Integrate[(i1/vol),{x,xmin,xmax}])//Timing

(i222=FullSimplify[i22])//Timing

From Michael Trott 2022-10-02:

(Sqrt[10 (5+Sqrt[5])]+(5+2 Sqrt[5]) ArcCoth[Sqrt[2+2/Sqrt[5]]])/40//N

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

((NIntegrate[(x^2)+(y^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))//Timing

(i=((Integrate[(x^2)+(y^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))//FullSimplify)//Timing

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))//Timing

(i=((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"])))//Timing

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=MinMax/@Transpose[PolyhedronCoordinates[p]]

ineq=PolyhedronData[pname,"RegionFunction"][x,y,z]

(i1=Integrate[Boole[ineq](Sqrt[(x^2)+(y^2)+(z^2)]),{z,zmin,zmax}])//Timing

NIntegrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}]

(i2=Integrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}])//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

((NIntegrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))//Timing

(i=((Integrate[(x^2)+(y^2)+(z^2),{x,y,z}∈p])/(PolyhedronData[pname,"Volume"]))//FullSimplify)//Timing

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

sphere=Midsphere[p//N]

Graphics3D[{{Opacity[.5],Yellow,p},{Red,#}},Boxed->False]&/@sphere

(sphere=Midsphere[p,Debug->True,"Simplification"->(FullSimplify[RootReduce[#]]&)])//Timing

(sphere=Midsphere[p,Method->"PointLineDistance",Debug->True,"Simplification"->(FullSimplify[RootReduce[#]]&)])//Timing

Region

PolyhedronData[pname,"Region"]

RegionFunction

PolyhedronData[pname,"RegionFunction"]

Collect[#,{x,y,z},RootReduce]&/@PolyhedronInequalities[p,{x,y,z}]

FullSimplify[%]

SimplePolyhedron

PolyhedronData[pname,"Simple"]

SimplePolyhedronQ[p]

Skeleton

PolyhedronData[pname,"Skeleton"]

PolyhedronData[pname,"Skeleton","Name"]

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

RootReduce[%]

SurfaceArea[p]//RootReduce//Timing

Total[Area/@PolyhedronData[pname,"Polygons"]]//RootReduce//Timing

VertexCount

PolyhedronData[pname,"VertexCount"]

VertexSubsetHulls

PolyhedronData[pname,"VertexSubsetHulls"]

Platonic

(h=VertexSubsetHulls[p,"Platonic","Skip"->{}])//Timing

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

PolyhedronVolume[p]//FullSimplify

Properties: "CanonicalPyramid"

{"CanonicalPyramid", n}

Circumsphere

Table[PolyhedronData[{"CanonicalPyramid",n},"Circumsphere"],{n,3,10}]

Table[Graphics3D[{Opacity[.5],Red,PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"],Yellow,PolyhedronData[{"CanonicalPyramid",n},"Circumsphere"]}],{n,3,10}]

Table[Graphics3D[{Opacity[.5],Red,PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"],Yellow,Sphere[{0,0,-((Cot[(π/(2 n))] (-2+Sec[(π/n)]))/(4 (Sqrt[2]) (Sqrt[-1+Sec[(π/n)]])))},((Cot[(π/(2 n))] Sec[(π/n)])/(4 (Sqrt[2]) (Sqrt[-1+Sec[(π/n)]])))]}],{n,3,6}]

FullSimplify[((((1/(2 (Sqrt[2]) (Sqrt[-1+Sec[(π/n)]]))){-(1/2) Cot[(π/(2 n))] (Sec[(π/n)]-2),(1/2)Cot[(π/(2 n))] Sec[(π/n)]}))^2)]

FullSimplify[Sqrt[%]]

Table[Graphics3D[{Opacity[.5],Red,PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"],Yellow,Sphere[{0,0,(1/8) Cos[((3 π)/(2 n))] ((Csc[(π/(2 n))])^2) (Sqrt[Sec[(π/n)]])},(1/16) ((Csc[(π/(2 n))])^3) (Sqrt[Sin[(π/n)] Tan[(π/n)]])]}],{n,3,6}]

DualScale

Table[PolyhedronData[{"CanonicalPyramid",n},"DualScale"],{n,3,10}]

Table[Graphics3D[{Opacity[.5],
Red,PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"],
Yellow,PolyhedronData[{"CanonicalPyramid",n},"Midsphere"],
Green,PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"]/.Polyhedron[v_,f_]:>Polyhedron[-v,f]
}],{n,3,6}]

Table[Graphics3D[{Opacity[.5],
Red,PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"],
Yellow,PolyhedronData[{"CanonicalPyramid",n},"Midsphere"],
Green,PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"]/.Polyhedron[v_,f_]:>Polyhedron[PolyhedronData[{"CanonicalPyramid",n},"DualScale"]v,f]
}],{n,3,6}]

Table[Graphics3D[{Opacity[.5],
Red,PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"],
Yellow,PolyhedronData[{"CanonicalPyramid",n},"Midsphere"],
Green,PolyhedronData[{"CanonicalPyramid",n},"Dual","Polyhedron"]
}],{n,3,10}]

EdgeCount

Table[PolyhedronData[{"CanonicalPyramid",n},"EdgeCount"],{n,3,10}]

FindSequenceFunction[%,n-2]//Factor

EdgeLengths

Table[PolyhedronData[{"CanonicalPyramid",n},"EdgeLengths"],{n,3,10}]

N[%]

Table[Piecewise[{{{1},n==3}},{1,(1/4) ((Csc[(π/(2 n))])^2)}],{n,3,10}]//FullSimplify

N[%]

EdgeLengthRatio

1/Divide@@@Table[PolyhedronData[{"CanonicalPyramid",n},"EdgeLengths"],{n,4,10}]//FullSimplify

Table[(1/4) ((Csc[(π/(2 n))])^2),{n,4,10}]//FullSimplify

RootReduce[%]

FaceCount

Table[PolyhedronData[{"CanonicalPyramid",n},"FaceCount"],{n,3,10}]

FindSequenceFunction[%,n-2]//Factor

FaceCountRules

Table[PolyhedronData[{"CanonicalPyramid",n},"FaceCountRules"],{n,3,10}]

GeneralizedDiameter

Table[PolyhedronData[{"CanonicalPyramid",n},"GeneralizedDiameter"],{n,3,10}]

N[%]

FullSimplify[(((((Csc[(π/(2 n))] (Sqrt[Sec[(π/n)]]))/(2 (Sqrt[2]) (Sqrt[-1+Sec[(π/n)]])))))^2)]

Table[(1/4) ((Csc[(π/(2 n))])^2),{n,3,10}]//FullSimplify

N[%]

Height

Table[Max[PolyhedronData[{"CanonicalPyramid",n},"VertexCoordinates"][[All,3]]],{n,3,10}]

N[%]

FullSimplify[((Cot[(π/(2 n))])/(2 (Sqrt[2]) (Sqrt[-1+Sec[(π/n)]])))]

FullSimplify[(Sqrt[(2/3)])-(1/(2 (Sqrt[6])))]

Table[Piecewise[{{((Sqrt[(3/2)])/2),n==3}},((Cot[(π/(2 n))])/(2 (Sqrt[2]) (Sqrt[-1+Sec[(π/n)]])))],{n,3,10}]//FullSimplify

N[%]

Insphere

Table[PolyhedronData[{"CanonicalPyramid",n},"Insphere"],{n,3,10}]

N[%]

Insphere[PolyhedronData[{"CanonicalPyramid",4},"Polyhedron"]]//FullSimplify

Insphere[PolyhedronData[{"CanonicalPyramid",5},"Polyhedron"]]/.Sphere[x_,r_]:>Sphere[ToAlgebraicRoot/@x,ToAlgebraicRoot@r]//Quiet//FullSimplify

Sphere[{0,0,-Tan[(π/(2 n))]-(((Sqrt[Cos[(π/n)]]) (-2+Cos[(π/n)]+(Sqrt[-((-2+Cos[(π/n)]) Cos[(π/n)])]) Tan[(π/(2 n))]))/(2 (Sqrt[4-2 Cos[(π/n)]]) (Sqrt[-1+Sec[(π/n)]])))},-(((Sqrt[Cos[(π/n)]]) (-2+Cos[(π/n)]+(Sqrt[-((-2+Cos[(π/n)]) Cos[(π/n)])]) Tan[(π/(2 n))]))/(2 (Sqrt[4-2 Cos[(π/n)]]) (Sqrt[-1+Sec[(π/n)]])))]/.n->5.

Table[Graphics3D[{Opacity[.5],Red,With[{r=(((Sqrt[2]) (Sqrt[9+16 Cos[(π/n)]+8 Cos[((2 π)/n)]-Cos[((4 π)/n)]])-2 Sin[((2 π)/n)])/(8 (Sqrt[2]) (1+Cos[(π/n)]) (Sqrt[Sec[(π/n)]-1])))},Sphere[{0,0,r-((Tan[(π/(2 n))])/(2 (Sqrt[2]) (Sqrt[Sec[(π/n)]-1])))},r]],Yellow,PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"]}],{n,4,10}]//N

Table[Graphics3D[{Opacity[.5],Red,PolyhedronData[{"CanonicalPyramid",n},"Insphere"],Yellow,PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"]}],{n,4,10}]

Insphere

Table[Graphics3D[{{Opacity[.5],Green,PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"]},{Blue,PolyhedronData[{"CanonicalPyramid",n},"Insphere"]}}],{n,3,10}]

Midradius

Table[PolyhedronData[{"CanonicalPyramid",n},"Midradius"],{n,3,10}]

N[%]

Table[Piecewise[{{(1/(2 (Sqrt[2]))), n == 3}},(1/(2 (Sqrt[2]) (Sqrt[Sec[(π/n)]-1])))],{n,3,10}]//FullSimplify

N[%]

Midsphere

Table[Graphics3D[{{Opacity[.5],Green,PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"]},{Blue,PolyhedronData[{"CanonicalPyramid",n},"Midsphere"]}}],{n,3,10}]

Net

Table[PolyhedronData[{"CanonicalPyramid",n},"Net"],{n,3,10}]

Polyhedron

Graphics3D/@Table[PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"],{n,3,10}]

RegionFunction

Table[Graphics3D[{PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"]}],{n,3,10}]

Table[PolyhedronData[{"CanonicalPyramid",n},"Region"]//Quiet,{n,3,10}]

SurfaceArea

Table[PolyhedronData[{"CanonicalPyramid",n},"SurfaceArea"],{n,3,10}]

N[%]

FullSimplify[((2 n ((Sqrt[-1+2 Sec[(π/n)]])+Tan[(π/(2 n))]))/(((2 (Sqrt[2]) (Sqrt[-1+Sec[(π/n)]])))^2))]

Table[((n ((Sqrt[2 Sec[(π/n)]-1])+Tan[(π/(2 n))]))/(4 (Sec[(π/n)]-1))),{n,3,10}]//FullSimplify

N[%]

VertexCount

Table[PolyhedronData[{"CanonicalPyramid",n},"VertexCount"],{n,3,10}]

FindSequenceFunction[%,n-2]//Factor

Volume

Table[PolyhedronData[{"CanonicalPyramid",n},"Volume"],{n,3,10}]

N[%]

FullSimplify[(((2/3) n ((Sec[(π/(2 n))])^2))/(((2 (Sqrt[2]) (Sqrt[-1+Sec[(π/n)]])))^3))]

Table[((n ((Sec[(π/(2 n))])^2))/(24 (Sqrt[2]) (((-1+Sec[(π/n)]))^(3/2)))),{n,3,10}]//FullSimplify

N[%]

Volume[PolyhedronData[{"CanonicalPyramid",4},"Polyhedron"]]//FullSimplify

Volume[PolyhedronData[{"CanonicalPyramid",5},"Polyhedron"]]//FullSimplify

{"CanonicalPyramid", 4}

p=PolyhedronData[pname={"CanonicalPyramid",4},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

RegionCentroid[p]//FullSimplify

(xbar=PolyhedronCentroid[p])//Timing

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]

SimplifyNumericallyDistinct[DihedralAngles[p]]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i1=((MomentOfInertia[p,{0,0,0}])/vol))//FullSimplify//Timing

i1//FullSimplify//Timing

(i2=PolyhedronInertiaTensor[p])//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

NIntegrate[((Sqrt[x^2+y^2])/vol),{x,y,z}∈p]

(rxy=((Integrate[(Sqrt[x^2+y^2]),{x,y,z}∈p])/vol))//Timing

FullSimplify[rxy]

N[%]

TrigToExp[(1/64) (8 (Sqrt[2])+ArcCosh[577])]

Table[(((1+(Sqrt[2])))^n),{n,10}]//Expand

(((1+(Sqrt[2])))^8)//Expand

(1/(4 (Sqrt[2])))+(1/8) Log[1+(Sqrt[2])]//FullSimplify

N[%]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

(rxy2=((Integrate[x^2+y^2,{x,y,z}∈p])/vol)//FullSimplify)//Timing

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

((NIntegrate[(Sqrt[x^2+y^2+z^2]),{x,y,z}∈p])/vol)

Integrate

(rxyz2=((Integrate[(Sqrt[x^2+y^2+z^2]),{x,y,z}∈p])/vol))//Timing

Divergence theorem

(rxy=MeanSphericalRadius[p,Debug->True])//Timing

Integrate over z first

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=MinMax/@Transpose[PolyhedronCoordinates[p]]

ineq=PolyhedronData[pname,"RegionFunction"][x,y,z]

(i1=Integrate[Boole[ineq](Sqrt[(x^2)+(y^2)+(z^2)]),{z,zmin,zmax}])//Timing

NIntegrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}]

(i2=Integrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}])//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

(rxyz2=((Integrate[x^2+y^2+z^2,{x,y,z}∈p])/vol)//FullSimplify)//Timing

RegionFunction

PolyhedronData[pname,"RegionFunction"]

(ineq=FullSimplify[PolyhedronInequalities[p,{x,y,z}]])//Timing

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

{"CanonicalPyramid", 5}

p=PolyhedronData[pname={"CanonicalPyramid",5},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

RegionCentroid[p]//FullSimplify

(xbar=PolyhedronCentroid[p])//Timing

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]

ArcCos[SimplifyNumericallyDistinct[Cos[DihedralAngles[p]],"Simplification"->RootReduce]]//FullSimplify

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i1=((MomentOfInertia[p,{0,0,0}])/vol))//Timing

i1//FullSimplify//Timing

(i2=PolyhedronInertiaTensor[p])//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

NIntegrate[((Sqrt[x^2+y^2])/vol),{x,y,z}∈p]

(rxy=((Integrate[(Sqrt[x^2+y^2]),{x,y,z}∈p])/vol))//Timing

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=MinMax/@Transpose[PolyhedronCoordinates[p]]

ineq=PolyhedronData[pname,"RegionFunction"][x,y,z]

(i1=Integrate[Boole[ineq](Sqrt[(x^2)+(y^2)]),{z,zmin,zmax}])//Timing

NIntegrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}]

(i2=Integrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax},Assumptions->ineq])//Timing

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

(rxy2=((Integrate[x^2+y^2,{x,y,z}∈p])/vol)//FullSimplify)//Timing

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

((NIntegrate[(Sqrt[x^2+y^2+z^2]),{x,y,z}∈p])/vol)

(rxyz2=((Integrate[(Sqrt[x^2+y^2+z^2]),{x,y,z}∈p])/vol))//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

(rxyz2=((Integrate[x^2+y^2+z^2,{x,y,z}∈p])/vol)//FullSimplify)//Timing

RegionFunction

PolyhedronData[pname,"RegionFunction"]

(ineq=FullSimplify[PolyhedronInequalities[p,{x,y,z}]])//Timing

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

{"CanonicalPyramid", 6}

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname={"CanonicalPyramid",6},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

RegionCentroid[p]//FullSimplify

(xbar=PolyhedronCentroid[p])//Timing

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]

N[%]

ArcCos[SimplifyNumericallyDistinct[Cos[DihedralAngles[p]],"Simplification"->RootReduce]]//FullSimplify

N[%]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i1=((MomentOfInertia[p,{0,0,0}])/vol))//FullSimplify//Timing

(i2=PolyhedronInertiaTensor[p])//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

N[%]

NIntegrate[((Sqrt[x^2+y^2])/vol),{x,y,z}∈p]

Integrate over polyhedron

(rxy=((Integrate[(Sqrt[(x^2)+(y^2)]),{x,y,z}∈p])/vol))//Timing

Divergence theorem

(rxy=MeanCylindricalRadius[p,"Simplification"->FullSimplify,Debug->True])//Timing

N[rxy]

LogSimplify[rxy]//FullSimplify

N[(1/16) (4+3Log[3])]

CAD

cad=CylindricalDecomposition[PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z},"Function"]

((NIntegrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxy=((Integrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

CAD over  1/6

reg=FullSimplify[PolyhedronData[pname,"RegionFunction"][x,y,z]&&0<y<Tan[Pi/3]x]

cad=CylindricalDecomposition[reg,{x,y,z},"Function"]

6((NIntegrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxy=6((Integrate[(Sqrt[(x^2)+(y^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

N[rxy]

LogSimplify[rxy]//FullSimplify

Integrate over x, y, z

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=MinMax/@Transpose[PolyhedronCoordinates[p]]

ineq=PolyhedronData[pname,"RegionFunction"][x,y,z]

(i1=Integrate[Boole[ineq](Sqrt[(x^2)+(y^2)]),{z,zmin,zmax}]/.p_Piecewise:>RootReduce/@p)//Timing

NIntegrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}]

(i11=FullSimplify[i1])//Timing

(i2=Integrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax},Assumptions->ineq])//Timing

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

(rxy2=((Integrate[x^2+y^2,{x,y,z}∈p])/vol)//FullSimplify)//Timing

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈p])/vol)

ClosestMeanSphericalRadius[%]

Integrate over polyhedron

(rxyz=((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)]),{x,y,z}∈p])/vol))//Timing

N[rxyz]

Divergence theorem [unevaluated integral]

(rxyz=MeanSphericalRadius[p,"Simplification"->FullSimplify,Debug->True])//Timing

N[rxyz]

LogSimplify[rxyz]//FullSimplify

CAD

cad=CylindricalDecomposition[PolyhedronData[pname,"RegionFunction"][x,y,z],{x,y,z},"Function"]

((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxyz=((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

N[rxyz,20]

rxysimp1=ResourceFunction["LogSimplify"][rxy]//FullSimplify

CAD over  1/6

reg=FullSimplify[PolyhedronData[pname,"RegionFunction"][x,y,z]&&0<y<Tan[Pi/3]x]

(cad=CylindricalDecomposition[reg,{x,y,z},"Function"])//Timing

6((NIntegrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol)

(rxyz=6((Integrate[(Sqrt[(x^2)+(y^2)+(z^2)])Boole[cad],{x,y,z}∈FullRegion[3]])/vol))//Timing

N[rxyz,20]

rxysimp1=LogSimplify[rxy]//FullSimplify

Boole Integrate doing z integral first

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=CoordinateBounds[p]

ineq=PolyhedronData[pname,"RegionFunction"][x,y,z]

(i1=Integrate[Boole[ineq](Sqrt[(x^2)+(y^2)+(z^2)]),{z,zmin,zmax}])//Timing

NIntegrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}]

(i2=Integrate[(i1/vol),{x,xmin,xmax},{y,ymin,ymax}])//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

(rxyz2=((Integrate[x^2+y^2+z^2,{x,y,z}∈p])/vol)//FullSimplify)//Timing

RegionFunction

PolyhedronData[pname,"RegionFunction"]

(ineq=FullSimplify[PolyhedronInequalities[p,{x,y,z}]])//Timing

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

{"CanonicalPyramid", 7}

p=PolyhedronData[pname={"CanonicalPyramid",7},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

(xbar1=ToAlgebraicRoot/@RegionCentroid[p])//Quiet//FullSimplify//Timing

(xbar=PolyhedronCentroid[p])//Timing

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]

N[%]

ArcCos[SimplifyNumericallyDistinct[Cos[DihedralAngles[p]],"Simplification"->ToAlgebraicRoot]]//FullSimplify

N[%]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i1=((MomentOfInertia[p,{0,0,0}])/vol))//Timing

Map[ToAlgebraicRoot,i1,{2}]//Quiet//Timing

(i2=PolyhedronInertiaTensor[p])//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

NIntegrate[((Sqrt[x^2+y^2])/vol),{x,y,z}∈p]

$Version

(rxy=((Integrate[(Sqrt[x^2+y^2]),{x,y,z}∈p])/vol))//Timing

FullSimplify[rxy]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

(rxy2=((Integrate[x^2+y^2,{x,y,z}∈p])/vol)//ToAlgebraicRoot)//Timing

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

(rxyz2=((Integrate[(Sqrt[x^2+y^2+z^2]),{x,y,z}∈p])/vol))//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

(rxyz2=((Integrate[x^2+y^2+z^2,{x,y,z}∈p])/vol)//ToAlgebraicRoot)//Timing

RegionFunction

PolyhedronData[pname,"RegionFunction"]

(ineq=FullSimplify/@Simplify[RootReduce/@PolyhedronInequalities[p,{x,y,z}]])//Timing

ineq/.{x->#,y->#2,z->#3}

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//ToAlgebraicRoot

{"CanonicalPyramid", 8}

p=PolyhedronData[pname={"CanonicalPyramid",8},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

(xbar1=ToAlgebraicRoot/@RegionCentroid[p])//Timing

(xbar=PolyhedronCentroid[p])//Timing

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]

N[%]

ArcCos[SimplifyNumericallyDistinct[Cos[DihedralAngles[p]],"Simplification"->RootReduce]]//FullSimplify

N[%]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i1=((MomentOfInertia[p,{0,0,0}])/vol))//Timing

Map[ToAlgebraicRoot,i1,{2}]//FullSimplify//Timing

(i2=PolyhedronInertiaTensor[p])//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

NIntegrate[((Sqrt[x^2+y^2])/vol),{x,y,z}∈p]

$Version

(rxy=((Integrate[(Sqrt[x^2+y^2]),{x,y,z}∈p])/vol))//Timing

FullSimplify[rxy]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

(rxy2=((Integrate[x^2+y^2,{x,y,z}∈p])/vol)//ToAlgebraicRoot)//Timing

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

(rxyz2=((Integrate[(Sqrt[x^2+y^2+z^2]),{x,y,z}∈p])/vol))//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

(rxyz2=((Integrate[x^2+y^2+z^2,{x,y,z}∈p])/vol)//ToAlgebraicRoot)//Timing

RegionFunction

PolyhedronData[pname,"RegionFunction"]

(ineq=FullSimplify/@Simplify[RootReduce/@PolyhedronInequalities[p,{x,y,z}]])//Timing

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

RootReduce[%]//FullSimplify

{"CanonicalPyramid", 9}

p=PolyhedronData[pname={"CanonicalPyramid",9},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

(xbar1=ToAlgebraicRoot/@RegionCentroid[p])//Quiet//Timing

(xbar=PolyhedronCentroid[p])//Timing

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]

ArcCos[SimplifyNumericallyDistinct[Cos[DihedralAngles[p]],"Simplification"->RootReduce]]//FullSimplify

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i1=((MomentOfInertia[p,{0,0,0}])/vol))//Timing

Map[ToAlgebraicRoot,i1,{2}]//FullSimplify//Quiet//Timing

(i2=PolyhedronInertiaTensor[p])//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

NIntegrate[((Sqrt[x^2+y^2])/vol),{x,y,z}∈p]

$Version

(rxy=((Integrate[(Sqrt[x^2+y^2]),{x,y,z}∈p])/vol))//Timing

FullSimplify[rxy]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

(rxy2=((Integrate[x^2+y^2,{x,y,z}∈p])/vol)//ToAlgebraicRoot)//Timing

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

(rxyz2=((Integrate[(Sqrt[x^2+y^2+z^2]),{x,y,z}∈p])/vol))//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

(rxyz2=((Integrate[x^2+y^2+z^2,{x,y,z}∈p])/vol)//ToAlgebraicRoot)//Timing

RegionFunction

PolyhedronData[pname,"RegionFunction"][x,y,z]

(ineq=FullSimplify[FullSimplify/@Simplify[RootReduce/@PolyhedronInequalities[p,{x,y,z}]]])//Timing

ineq/.{x->#,y->#2,z->#3}

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

{"CanonicalPyramid", 10}

p=PolyhedronData[pname={"CanonicalPyramid",10},"Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

(xbar1=RootReduce/@RegionCentroid[p])//FullSimplify//Quiet//Timing

(xbar=PolyhedronCentroid[p])//Timing

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]

ArcCos[SimplifyNumericallyDistinct[Cos[DihedralAngles[p]],"Simplification"->RootReduce]]//FullSimplify

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i1=((MomentOfInertia[p,{0,0,0}])/vol))//Timing

Map[ToAlgebraicRoot,i1,{2}]//FullSimplify//Timing

(i2=PolyhedronInertiaTensor[p])//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

NIntegrate[((Sqrt[x^2+y^2])/vol),{x,y,z}∈p]

$Version

(rxy=((Integrate[(Sqrt[x^2+y^2]),{x,y,z}∈p])/vol))//Timing

FullSimplify[rxy]

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

(rxy2=((Integrate[x^2+y^2,{x,y,z}∈p])/vol)//ToAlgebraicRoot)//Timing

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

(rxyz2=((Integrate[(Sqrt[x^2+y^2+z^2]),{x,y,z}∈p])/vol))//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

(rxyz2=((Integrate[x^2+y^2+z^2,{x,y,z}∈p])/vol)//ToAlgebraicRoot)//Timing

RegionFunction

PolyhedronData[pname,"RegionFunction"][x,y,z]

(ineq=FullSimplify/@Simplify[RootReduce/@PolyhedronInequalities[p,{x,y,z}]])//Timing

ineq/.{x->#,y->#2,z->#3}

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[p]}

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//ToAlgebraicRoot

ToRadicals[%]

Construction

Construction

RegularRightPyramid[n_Integer,h_,a_:1]:=Module[{v=Append[Append[#,0]&/@CirclePoints[a,n],{0,0,h}],e=Partition[Range[n],2,1,1],f},f=Append[Append[#,n+1]&/@e,Range[n,1,-1]];
GraphicsComplex[v,Polygon[f]]]/;n>2

gc=RegularRightPyramid[5,1,1]

Graphics3D[{FaceForm[Green,Red],gc}]

poly=Polyhedron[gc[[1]],gc[[2,1]]]

can=FindCanonicalPolyhedron[poly,MaxIterations->5000]

Graphics3D[can]

v=PolyhedronCoordinates[can];

(v[[All,-1]]//Min)//N

(v[[All,-1]]//Max)//N

dual=can/.Polyhedron[v_,f_]:>Polyhedron[(RotationMatrix[Pi/5,{0,0,1}].{#1,#2,-#3})&@@@v,Reverse/@f];

dv=PolyhedronCoordinates[dual];

Graphics3D[{{Opacity[.5],Green,can,Red,dual,Yellow,Sphere[]},
Text[Subscript[p,1],v[[1]],Background->White],
Text[Subscript[p,3],v[[6]],Background->White],
Text[Subscript[p,2],v[[2]],Background->White],
Text[Subscript[d,0],dv[[5]],Background->White],
Text[Subscript[d,1],dv[[1]],Background->White],
Text[Subscript[d,3],dv[[6]],Background->White],
Text[Subscript[d,2],dv[[2]],Background->White]
},Boxed->False]

p3={0,0,h};
p1={R,0,-z};
p2={R Cos[((2π)/n)],R Sin[((2π)/n)],-z};
d3={0,0,-h};
d0={R Cos[-(π/n)],R Sin[-(π/n)],z};
d1={R Cos[(π/n)],R Sin[(π/n)],z};
d2={R Cos[((3π)/n)],R Sin[((3π)/n)],z};

Circumferential edges are perpendicular to lateral edges:

Dot[p2-p3,d1-d2]//FullSimplify

Intersecting edges are coplanar:

eqn1=Det[Append[#,1]&/@{p1,p2,d1,d3}]==0//FullSimplify

eqn1=(-h+z+(h+z) Cos[(π/n)]) ==0//FullSimplify

Same relation:

Det[Append[#,1]&/@{d1,d2,p2,p3}]==0//FullSimplify

Edges intersect at midradius 1:

eqn2=FullSimplify[#.#&@Mean[{p1,p2}]==1]

Same relation:

FullSimplify[#.#&@Mean[{d1,d2}]==1]

Long edge intersection with short edge is perpendicular to short edge:

eqn3=FullSimplify[Dot[p1-p3,d0=d1]==0]

eqn3=FullSimplify[Dot[p1-p3,Mean[{d0,d1}]]==0]

Solve[{eqn1,eqn2,eqn3},{z,R,h}]//FullSimplify

soln={z->(((Sqrt[-1+Cos[(π/n)]]) (Sqrt[Cos[(π/n)]]))/((Sqrt[2]) (Sqrt[-((Cos[(π/(2 n))])^2) Cos[(π/n)]]))),R->(2/(Sqrt[1+2 Cos[(π/n)]+Cos[((2 π)/n)]])),h->-((1+Cos[(π/n)])/((Sqrt[2]) (Sqrt[-((Cos[(π/(2 n))])^2) Cos[(π/n)]]) (Sqrt[1-Sec[(π/n)]])))};

FullSimplify[((((((Sqrt[-1+Cos[(π/n)]]) (Sqrt[Cos[(π/n)]]))/((Sqrt[2]) (Sqrt[-((Cos[(π/(2 n))])^2) Cos[(π/n)]])))))^2)]

FullSimplify[(((-((1+Cos[(π/n)])/((Sqrt[2]) (Sqrt[-((Cos[(π/(2 n))])^2) Cos[(π/n)]]) (Sqrt[1-Sec[(π/n)]])))))^2)]

p5=Block[{n=5},Append[Append[#,z]&/@CirclePoints[R,n],{0,0,h}]/.soln]//FullSimplify

d5=Block[{n=5},Append[Append[#,-z]&/@CirclePoints[-R,n],{0,0,-h}]/.soln]//FullSimplify

Graphics3D[{Opacity[.5],Yellow,Sphere[],Green,ConvexHullRegion[p5],Red,ConvexHullRegion[d5]}]

p4=Block[{n=4},Append[Append[#,z]&/@CirclePoints[R,n],{0,0,h}]/.soln]//FullSimplify

d4=Block[{n=4},Append[Append[#,-z]&/@CirclePoints[-R,n],{0,0,-h}]/.soln]//FullSimplify

Graphics3D[{Opacity[.5],Yellow,Sphere[],Green,ConvexHullRegion[p4],Red,ConvexHullRegion[d4]}]

p3=Block[{n=3},Append[Append[#,z]&/@CirclePoints[R,n],{0,0,h}]/.soln]//FullSimplify

d3=Block[{n=3},Append[Append[#,-z]&/@CirclePoints[-R,n],{0,0,-h}]/.soln]//FullSimplify

Graphics3D[{Opacity[.5],Yellow,Sphere[],Green,ConvexHullRegion[p3],Red,ConvexHullRegion[d3]}]

Solution

soln={z->-Tan[(π/(2 n))],R->(2/(Sqrt[1+2 Cos[(π/n)]+Cos[((2 π)/n)]])),h->Cot[(π/(2 n))]};

Circumsphere

FullSimplify[Circumsphere[Tetrahedron[Append[Table[{R Cos[((2π i)/n)],R Sin[((2π i )/n)],z},{i,0,2}],{0,0,h}]]]/.soln]

Sphere[{0,0,-(1/2) Cot[(π/(2 n))] (Sec[(π/n)]-2)},(1/2) Cot[(π/(2 n))] Sec[(π/n)]]

Edge lengths

Sqrt[FullSimplify[(p1-p2).(p1-p2)/.{z->Tan[(π/(2 n))],R->(2/(Sqrt[1+2 Cos[(π/n)]+Cos[((2 π)/n)]])),h->Cot[(π/(2 n))]}]]//FullSimplify

Sqrt[FullSimplify[(p2-p3).(p2-p3)/.{z->Tan[(π/(2 n))],R->(2/(Sqrt[1+2 Cos[(π/n)]+Cos[((2 π)/n)]])),h->Cot[(π/(2 n))]}]]//FullSimplify

Csc[(π/(2 n))] (Sqrt[Sec[(π/n)]])

EdgeLengthRatio

FullSimplify[(((((Sqrt[((Csc[(π/(2 n))])^2) Sec[(π/n)]])/(2 (Sqrt[2]) (Sqrt[-1+Sec[(π/n)]])))))^2)]

FullSimplify[Sqrt[%]]

(1/4) ((Csc[(π/(2 n))])^2)

FullSimplify[((Sqrt[(2-2 Cos[(π/n)]+Cos[((2 π)/n)]) ((Csc[(π/(2 n))])^2) Sec[(π/n)]])/(2 (Sqrt[2]) (Sqrt[-1+Sec[(π/n)]])))]

FullSimplify[Sqrt[%]]

(1/4) ((Csc[(π/(2 n))])^2)(Sqrt[8+(-1+2 Cos[(π/n)]) ])

GeneralizedDiameter

FullSimplify[(Sqrt[(((h-z))^2)+(R^2)])/.soln]

FullSimplify[Csc[(π/(2 n))](Sqrt[ Sec[(π/n)]])]

Insphere

Insphere[PolyhedronData[{"CanonicalPyramid",4},"Polyhedron"]]//FullSimplify

N[%]

Insphere[PolyhedronData[{"CanonicalPyramid",5},"Polyhedron"]]/.Sphere[x_,r_]:>Sphere[ToAlgebraicRoot/@x,ToAlgebraicRoot@r]//Quiet//FullSimplify

Insphere[PolyhedronData[{"CanonicalPyramid",6},"Polyhedron"]]/.Sphere[x_,r_]:>Sphere[ToAlgebraicRoot/@x,ToAlgebraicRoot@r]//Quiet//FullSimplify

N[%]

eqn=FullSimplify[r==RegionDistance[InfinitePlane[{p1,p2,p3}],{0,0,r-z}]/.{z->Tan[(π/(2 n))],R->(2/(Sqrt[1+2 Cos[(π/n)]+Cos[((2 π)/n)]])),h->Cot[(π/(2 n))]}]

Assuming[n>2,Solve[2 (Sqrt[((Cos[(π/n)] (((-2+r Sin[(π/n)]))^2))/(8+9 Cos[(π/n)]-Cos[((3 π)/n)]))])==r,r]]//FullSimplify

Table[%,{n,3,6}]//N

Table[(((Sqrt[-((-2+Cos[(π/n)]) Cos[(π/n)])])-Sin[(π/n)]+Tan[(π/(2 n))])/(2 (Sqrt[2]) (Sqrt[-1+Sec[(π/n)]]))),{n,3,6}]//N

Solve[eqn,r]//FullSimplify

Table[((((Sqrt[2]) (Sqrt[9+16 Cos[(π/n)]+8 Cos[((2 π)/n)]-Cos[((4 π)/n)]])-2 Sin[((2 π)/n)])/(4+4 Cos[(π/n)]))/(2 (Sqrt[2]) (Sqrt[-1+Sec[(π/n)]]))),{n,3,7}]//N

FullSimplify[((((Sqrt[2]) (Sqrt[9+16 Cos[(π/n)]+8 Cos[((2 π)/n)]-Cos[((4 π)/n)]])-2 Sin[((2 π)/n)])/(4+4 Cos[(π/n)]))/(2 (Sqrt[2]) (Sqrt[-1+Sec[(π/n)]])))]

Table[(((Sqrt[2]) (Sqrt[9+16 Cos[(π/n)]+8 Cos[((2 π)/n)]-Cos[((4 π)/n)]])-2 Sin[((2 π)/n)])/(8 (Sqrt[2]) (1+Cos[(π/n)]) (Sqrt[-1+Sec[(π/n)]]))),{n,3,7}]//N

Table[Insphere[PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"]//N][[2]],{n,3,7}]//Chop

Table[(((((Sqrt[2]) (Sqrt[9+16 Cos[(π/n)]+8 Cos[((2 π)/n)]-Cos[((4 π)/n)]])-2 Sin[((2 π)/n)])/(4+4 Cos[(π/n)]))-Tan[(π/(2 n))])/(2 (Sqrt[2]) (Sqrt[-1+Sec[(π/n)]]))),{n,3,7}]//N

FullSimplify[(((((Sqrt[2]) (Sqrt[9+16 Cos[(π/n)]+8 Cos[((2 π)/n)]-Cos[((4 π)/n)]])-2 Sin[((2 π)/n)])/(4+4 Cos[(π/n)]))-Tan[(π/(2 n))])/(2 (Sqrt[2]) (Sqrt[-1+Sec[(π/n)]])))]

Table[(((Sqrt[9+16 Cos[(π/n)]+8 Cos[((2 π)/n)]-Cos[((4 π)/n)]]) ((Sec[(π/(2 n))])^2)-4 (Sqrt[2]) Sin[(π/n)])/(16 (Sqrt[-1+Sec[(π/n)]]))),{n,3,7}]//N

Table[Insphere[PolyhedronData[{"CanonicalPyramid",n},"Polyhedron"]//N][[1,3]],{n,3,7}]//Chop

With[{r=(((Sqrt[2]) (Sqrt[9+16 Cos[(π/n)]+8 Cos[((2 π)/n)]-Cos[((4 π)/n)]])-2 Sin[((2 π)/n)])/(8 (Sqrt[2]) (1+Cos[(π/n)]) (Sqrt[-1+Sec[(π/n)]])))},Sphere[{0,0,r-((Tan[(π/(2 n))])/(2 (Sqrt[2]) (Sqrt[-1+Sec[(π/n)]])))},r]]

FullSimplify[(((Sqrt[2]) (Sqrt[9+16 Cos[(π/n)]+8 Cos[((2 π)/n)]-Cos[((4 π)/n)]])-2 Sin[((2 π)/n)])/(8 (Sqrt[2]) (1+Cos[(π/n)]) (Sqrt[-1+Sec[(π/n)]])))]

Polygon

FullSimplify[Dot[Normalize[p1-p3],Normalize[p2-p3]]/.{z->Tan[(π/(2 n))],R->(2/(Sqrt[1+2 Cos[(π/n)]+Cos[((2 π)/n)]])),h->Cot[(π/(2 n))]},n>2]

ArcCos[4 Cos[(π/n)]-Cos[((2 π)/n)]-2]/.n->4.

Table[ArcCos[4 Cos[(π/n)]-Cos[((2 π)/n)]-2],{n,3,20}]//N

FullSimplify[Dot[Normalize[p3-p1],Normalize[p2-p1]]/.{z->Tan[(π/(2 n))],R->(2/(Sqrt[1+2 Cos[(π/n)]+Cos[((2 π)/n)]])),h->Cot[(π/(2 n))]},n>2]

ArcCos[1-Cos[(π/n)]]/.n->4.

ArcCos[ToAlgebraicRoot/@Cos[PolygonAngle[PolyhedronData[{"CanonicalPyramid",4},"Polygons"][[1]]]]]//Quiet

N[%]

Graphics[{FaceForm[LightYellow],EdgeForm[Black],CanonicalPyramidNet[4]}]

Total[Area/@Flatten[Normal[CanonicalPyramidNet[4]]]]//ToAlgebraicRoot//FullSimplify

PolyhedronData[{"CanonicalPyramid",4},"SurfaceArea"]

Total[Area/@Flatten[Normal[CanonicalPyramidNet[5]]]]//ToAlgebraicRoot//FullSimplify

PolyhedronData[{"CanonicalPyramid",5},"SurfaceArea"]

SurfaceArea

FullSimplify[n Area[Triangle[{{0,0,h},{R,0,z},{R Cos[((2π)/n)],R Sin[((2π)/n)],z}}]]+(1/2)n (R^2)Sin[((2π)/n)]/.soln]

Volume

FullSimplify[(1/12)n Cot[(π/n)](R^2)(h-z)/.soln]

FullSimplify[(1/3)(1/2)n Sin[((2Pi)/n)](R^2)(h-z)/.soln]

Net construction

Canonical

PolyhedronData

<<MathWorld`Polyhedra`

file=OpenWrite["~/pyramid.m"]

Do[WriteString[file,PolyhedronDataString[CanonicalPyramid[n],
"StandardName"->{"CanonicalPyramid",n},
"Name"->"canonical "<>ToString[n]<>"\[Hyphen]trapezohedron",
"DualName"->{"CanonicalPyramid",n},
"DualScale"->-1,
"Classes"->{"Canonical"},
Debug->True
]],{n,4,10}]