Pentagonal Wedge

Author

Eric W. Weisstein
August 24, 2023

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

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

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

Polyhedron

Solid

Graphics3D[{Opacity[.5],PolyhedronData["PentagonalWedge","Polyhedron"]}]

Graphics3D[{FaceForm[Green,Red],PolyhedronData["PentagonalWedge","Polyhedron"]}]

Graphics3D[pcentered,Axes->True]

Region

PolyhedronData["PentagonalWedge","Region"]

Net

PolyhedronData["PentagonalWedge","Net"]

PolyhedronData["PentagonalWedge","Net","Colored"]

Properties

Initialization

<<MathWorld`Polyhedra`

p=PolyhedronData[pname="PentagonalWedge","Polyhedron"]

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData["PentagonalWedge","Centroid"]

RegionCentroid[p]//FullSimplify

PolyhedronCentroid[p,vol]//Timing

Circumsphere

circumsphere=PolyhedronData["PentagonalWedge","Circumsphere"]

Circumsphere[p]//RootReduce//FullSimplify//Timing

MyCircumsphere[p]//FullSimplify//Timing

N[{Sin[2Pi/5],(1/(Sqrt[2-(2/(Sqrt[5]))])),(Sqrt[(5/8)+((Sqrt[5])/8)]),(1/2) (Sqrt[(1/2) (5+(Sqrt[5]))])}]

Graphics3D[{{Yellow,Opacity[.3],circumsphere},{Red,Opacity[.5],p}},Boxed->False]

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

SortBy[FullSimplify@PolyhedronEdgeLengths[p],N]

Tally[%]

GeneralizedDiameter

PolyhedronData["PentagonalWedge","GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify

InertiaTensor

PolyhedronData["PentagonalWedge","InertiaTensor"]

(i=PolyhedronInertiaTensor[p,vol]//FullSimplify)//Timing

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

Insphere

PolyhedronData["PentagonalWedge","Insphere"]

bug(393059): Insphere[prism] polyhedron blob in message pinks and gives badge of shame

Insphere[p]//Timing

MyInsphere[p,Debug->True,"Simplification"->FullSimplify]//Timing

MyInsphere[p//N]

MeanCylindricalRadius

PolyhedronData["PentagonalWedge","MeanCylindricalRadius"]

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

Integrate over polyhedron [unevaluated]

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

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/2

reg=FullSimplify[PolyhedronData[pname,"RegionFunction"][x,y,z]&&x>0]

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

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

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

N[rxy]

LogSimplify[rxy]//FullSimplify

Divergence theorem [unevaluated integral]

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

MeanSquareCylindricalRadius

PolyhedronData["PentagonalWedge","MeanSquareCylindricalRadius"]

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

MeanSphericalRadius

PolyhedronData["PentagonalWedge","MeanSphericalRadius"]

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

MeanSquareSphericalRadius

PolyhedronData["PentagonalWedge","MeanSquareSphericalRadius"]

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

Midsphere

PolyhedronData["PentagonalWedge","Midsphere"]

Midsphere[p]//Timing

Midsphere[p//N]

Region

PolyhedronData["PentagonalWedge","Region"]

RegionFunction

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

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

{Region@ImplicitRegion[ineq,{x,y,z}],Graphics3D[{Opacity[.5],p,PointSize[Large],Point[{0,0,0}]}]}

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

Skeleton

PolyhedronData["PentagonalWedge","Skeleton"]

graphdata=RecognizeGraph[%]

SurfaceArea

PolyhedronData["PentagonalWedge","SurfaceArea"]

PolyhedronSurfaceArea[p]//FullSimplify//Timing

PolyhedronSurfaceArea[p]//ToAlgebraicRoot

s1=SurfaceArea[p]//ToAlgebraicRoot

Volume

vol=PolyhedronData["PentagonalWedge","Volume"]

(vol1=PolyhedronVolume[pcentered]//ToAlgebraicRoot//FullSimplify)//Timing

(vol4=Integrate[1,{x,y,z}∈PolyhedronData["PentagonalWedge","Region"]])//FullSimplify//Timing

Volume[p]//ToAlgebraicRoot//FullSimplify//Timing

Wrong:

(vol2=PolyhedronVolume[p]//ToAlgebraicRoot//FullSimplify)//Timing

(vol3=PolyhedronVolume[p,Method->"Pyramids"]//ToAlgebraicRoot//FullSimplify)//Timing

Definition

Michon

http://nbarth.net/notes/src/notes-calc-raw/others/X-numericana/polyhedra.htm#hexahedra

Wikipedia

https://en.wikipedia.org/wiki/Hexahedron#Convex,_Others

Construction

Equal pentagons and triangles

Pentagon in the z=0 plane and side along x axis with midpoint at the origin:

c=Append[#,0]&/@CirclePoints[{0,Csc[Pi/5]/2},{Csc[Pi/5]/2,Pi/2},5]//FullSimplify

Graphics3D[Polygon[c],Axes->True]

Polygon[{c[[3]],c[[4]],{0,a,h}}]

With[{x1=c[[3]],x2=c[[4]],x3={0,a,h},x4={x,y,z}},Dot[x3-x1,Cross[x2-x1,x4-x3]]]//FullSimplify

eqn={
h (-a+y)+(-(1/2) (Sqrt[1-(2/(Sqrt[5]))])+a) (h-z)==0,
SquaredEuclideanDistance[c[[4]],{0,a,h}]==GoldenRatio^2,
SquaredEuclideanDistance[c[[4]],{x,y,z}]==1,
SquaredEuclideanDistance[c[[5]],{x,y,z}]==1,
SquaredEuclideanDistance[{0,a,h},{x,y,z}]==1}/.Abs->Identity

eqn2=FullSimplify[eqn]//Union

var=Variables[Subtract@@@eqn2]

Length/@{eqn2,var}

(soln=Solve[eqn2,var,PositiveReals])//Timing

soln2=soln[[1]]/.r_Root:>ToAlgebraicRoot[r]//ToRadicals

v=Join[c,{{x,y,z},{-x,y,z},{0,a,h}}]/.soln2

pentagonalwedge=ConvexHullRegion[v]

Graphics3D[{FaceForm[Green,Red],pentagonalwedge},Boxed->False]

Graphics3D[{Opacity[.5],pentagonalwedge},Boxed->False]

PolyhedronEdgeLengths[pentagonalwedge]//FullSimplify

faces=Normal/@PolyhedronPolygons[poly1]

Graphics3D[{{Opacity[.5],poly1},
MapIndexed[Text[#2[[1]],Mean[#],Background->White]&,faces[[All,1]]]},Boxed->False]

MyDihedralAngle[faces[[{5,6}]]]//FullSimplify

ArcTan[2]//N

N[ArcTan[2]/Degree,20]

Tetrahedron truncation

v0=PolyhedronData["Tetrahedron","Vertices"];
f=PolyhedronData["Tetrahedron","Faces","Coordinates"];

Graphics3D[{{Opacity[.8],PolyhedronData["Tetrahedron","Polyhedron"]},MapIndexed[Text[#2[[1]],#,Background->White]&,v0],
MapIndexed[Text[#2[[1]],Mean[#],Background->Yellow]&,f]}]

third[{a_,b_}]:=a+(b-a)/3

v=Join[v0[[{1,4}]],third[v0[[#]]]&/@{{2,4},{2,1},{2,3},{3,2},{3,1},{3,4}}];

poly=ConvexHullRegion[v]

figure=Graphics3D[{{Dashed,PolyhedronData["Tetrahedron","Lines"]},Opacity[.5],poly},Boxed->False,Method->{"ShrinkWrap"->True}]

Version for W|A:

figure/.Polyhedron[v_,f_]:>(Polygon[v[[#]]]&/@f)

Length/@Through[{PolyhedronCoordinates,PolyhedronEdges,PolyhedronFaces}[poly]]

Sort@Tally[Length/@PolyhedronFaces[poly]]

g=SkeletonGraph[poly]

r=RecognizeGraph[g]

GraphData[r,"Graph","All"]

Net construction

v=Join[CirclePoints[{0,(1/2)(Cot[Pi/5])},{Csc[Pi/5]/2,Pi/2},5],CirclePoints[{0,-(1/2)(Cot[Pi/5])},{Csc[Pi/5]/2,-Pi/2},5]]//Union;
v=Join[v,{UnitDistancePoint[v[[6]],v[[10]],1],UnitDistancePoint[v[[2]],v[[8]],2]}]//FullSimplify

ps=Polygon[v,{{6,10,4,8,2},{6,2,7,3,9},{11,10,6},{2,8,12}}];

Graphics[{FaceForm[LightYellow],EdgeForm[Black],ps,MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

v2=PolyhedronData["PentagonalWedge","Polyhedron"]//PolyhedronCoordinates

Graphics3D[{{Opacity[.5],PolyhedronData["PentagonalWedge","Polyhedron"]},MapIndexed[Text[#2[[1]],#,Background->White]&,v2]},Boxed->False]

ArcCos[Dot[Normalize[v2[[7]]-v2[[8]]],Normalize[v2[[1]]-v2[[8]]]]]//FullSimplify

v=Join[v,{v[[3]]+GoldenRatio RotationMatrix[-2Pi/5].(v[[9]]-v[[3]])}];

Length[v]

v

v=Join[v,{v[[13]]+RotationMatrix[-2Pi/5].(v[[3]]-v[[13]])/GoldenRatio}];

{1,-1}{a,b}

v=Join[v,{v[[13]]{-1,1},v[[14]]{-1,1}}];

v=v//FullSimplify

Reverse/@{{-(1/2),0},{-(1/2),0},{0,-(1/2) (Sqrt[5+2 (Sqrt[5])])},{0,(1/2) (Sqrt[5+2 (Sqrt[5])])},{(1/2),0},{(1/2),0},{(1/4) (-1-(Sqrt[5])),-(1/2) (Sqrt[(1/2) (5+(Sqrt[5]))])},{(1/4) (-1-(Sqrt[5])),(1/2) (Sqrt[(1/2) (5+(Sqrt[5]))])},{(1/4) (1+(Sqrt[5])),-(1/2) (Sqrt[(1/2) (5+(Sqrt[5]))])},{(1/4) (1+(Sqrt[5])),(1/2) (Sqrt[(1/2) (5+(Sqrt[5]))])},{(1/8) (3+(Sqrt[5])+(Sqrt[6 (5+(Sqrt[5]))])),(1/4) (Sqrt[7-(Sqrt[5])-(Sqrt[30-6 (Sqrt[5])])])},{(1/8) (-3-(Sqrt[5])-(Sqrt[6 (5+(Sqrt[5]))])),(1/4) (Sqrt[7-(Sqrt[5])-(Sqrt[30-6 (Sqrt[5])])])},{(1/4) (3+(Sqrt[5])),-(1/4) (Sqrt[50+22 (Sqrt[5])])},{(1/2) (1+(Sqrt[5])),-(1/2) (Sqrt[5+2 (Sqrt[5])])},{(1/4) (-3-(Sqrt[5])),-(1/4) (Sqrt[50+22 (Sqrt[5])])},{(1/2) (-1-(Sqrt[5])),-(1/2) (Sqrt[5+2 (Sqrt[5])])}}

Sort[{{6,10,4,8,2},{6,2,7,3,9},{11,10,6},{2,8,12},{3,13,14,9},{7,16,15,3}}]

ps=Polygon[v,{{6,10,4,8,2},{6,2,7,3,9},{11,10,6},{2,8,12},{3,13,14,9},{7,16,15,3}}];

Graphics[{FaceForm[LightYellow,Red],EdgeForm[Black],ps,MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

PolyhedronData

file=OpenWrite["~/pentagonal-wedge.m"]

PolyhedronDataString[pentagonalwedge,
"StandardName"->"PentagonalWedge",
"Name"->"pentagonal wedge",
"Information"->"PentagonalWedge",
Debug->True]

PolyhedronDataString[canonicalpentagonalwedge,
"StandardName"->"CanonicalPentagonalWedge",
"Name"->"canonical pentagonal wedge",
"Information"->"PentagonalWedge",
Debug->True]