Polygrammic Prism

Author

Eric W. Weisstein
April 7, 2022

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

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

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

Figure

GraphicsRow[Table[PolyhedronData[{"Prism",{n,2}}],{n,{5,6,8}}]]

Properties: {"Prism", {5, 2}}

Initialization

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

AdjacentFaceIndices

PolyhedronData[pname,"AdjacentFaceIndices"]

%==AdjacentFaceIndices[p]

Centroid

PolyhedronData[pname,"Centroid"]

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

RegionCentroid[p]//FullSimplify//Timing

PolyhedronCentroid[p]//FullSimplify//Quiet//Timing

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

sphere=Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

Compound

PolyhedronData[pname,"Compound"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]

ConvexHull

PolyhedronData[pname,"ConvexHull"]

convexhull=ConvexHullRegion[PolyhedronData[pname,"Vertices"]]

v=PolyhedronCoordinates[convexhull]

Sort[(convexhull[[2]]/.i_Integer:>v[[i]])/.Thread[PolyhedronData[pname,"Vertices"]->Range[PolyhedronData[pname,"V"]]]]

Graphics3D[{FaceForm[Green,Red],convexhull,MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

EuclideanDistance@@v[[{7,8}]]//FullSimplify

N[%]

EuclideanDistance@@v[[{5,8}]]//FullSimplify

{Graphics3D[{Red,Opacity[.5],p}],Graphics3D[{Blue,Opacity[.5],PolyhedronData[pname,"ConvexHull"][[1]]}]}

Show[%]

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhull]]//Tally

N[%]

Graphics3D[{p,MapIndexed[Text[#2[[1]],#,Background->White]&,p[[1]]]}]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]

SimplifyNumericallyDistinct[DihedralAngles[p]]==%

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"]

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

Hull

PolyhedronData[pname,"Hull","Name"]

PolyhedronData[pname,"Hull","Scale"]

PolyhedronData[pname,"Hull"]

{Graphics3D[{Opacity[.5],Red,p}],Graphics3D[{Opacity[.5],Blue,PolyhedronData[pname,"Hull"][[1]]}]}

Show[%]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

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

PolyhedronInertiaTensor[p]//Timing

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]

sphere=MyInsphere[N[p,20]]

sphere=MyInsphere[p//N]

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

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

N[%]

Integrate over polyhedron

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

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

2D

bug(431646): Integrate[Sqrt[x^2 + y^2] OneTenthOfAPentagram, ...] returns wrong result

poly=Polygon[PolyhedronData[pname,"Polygons"][[-1,1,All,;;2]]]

Graphics[{poly,MapIndexed[Text[#2[[1]],#,Background->White]&,poly[[1]]]}]

(area=Integrate[1,{x,y}∈poly]//FullSimplify)//Timing

area=(1/2) (Sqrt[(5/2) (5+(Sqrt[5]))]);

((NIntegrate[(Sqrt[(x^2)+(y^2)]),{x,y}∈poly])/area)

(rxy=((Integrate[(Sqrt[(x^2)+(y^2)]),{x,y}∈poly])/area))//Timing

halfkite=Polygon[Append[poly[[1]][[{10,9}]],{0,0}]]

halfkite=Polygon[];

Graphics[halfkite,Axes->True]

Solve[1+4 y==(Sqrt[5]),y]

N[%]

10((NIntegrate[(Sqrt[(x^2)+(y^2)]),{x,y}∈halfkite])/area)

(rxy=10((Integrate[(Sqrt[(x^2)+(y^2)]),{x,y}∈halfkite])/area))//Timing

ineq=Inequalities[halfkite,{x,y}]//FullSimplify

ineq2=((Sqrt[5])-5 y)≥FullSimplify@((5 (-1+(Sqrt[5])))/((Sqrt[2 (5+(Sqrt[5]))]) )) x&&x≥FullSimplify@((Sqrt[10 (5+(Sqrt[5]))])/(5 (-1+(Sqrt[5])) )) y&&y≥0

(rxy=10((NIntegrate[(Sqrt[(x^2)+(y^2)])Boole[ineq],{x,y}∈FullRegion[2]])/area))

ineq2=(Sqrt[5])-5 y≥(Sqrt[5 (5-2 (Sqrt[5]))]) x&&x≥(Sqrt[1+(2/(Sqrt[5]))]) y&&y≥0;

(rxy=10((NIntegrate[(Sqrt[(x^2)+(y^2)])Boole[ineq2],{x,y}∈FullRegion[2]])/area))

(rxy=10((Integrate[(Sqrt[(x^2)+(y^2)])Boole[ineq2],{x,y}∈FullRegion[2]])/area))//Timing

N[rxy,10]

(rxy1=10((Integrate[(Sqrt[(x^2)+(y^2)])Boole[ineq2],{x,-∞,∞}])/area)//FullSimplify)//Timing

NIntegrate[rxy1,{y,-∞,∞}]

(rxy=Integrate[rxy1,{y,-∞,∞}])//Timing

N[rxy,20]

Solve[1+4 y==(Sqrt[5]),y]

NIntegrate[ ((NumericalApproximation[Root, (RowDefault["1.18", FEExpressionsNumericalApproximationElider]), Root[5-5 ((#1)^2)+((#1)^4)&,3], ])/5)(2 (Sqrt[5]) (Sqrt[9+4 (Sqrt[5])+2 y (-20-9 (Sqrt[5])+(25+11 (Sqrt[5])) y)])-10 y (Sqrt[9+4 (Sqrt[5])+2 y (-20-9 (Sqrt[5])+(25+11 (Sqrt[5])) y)])-(y^2) (10+6 (Sqrt[5])+Log[3125]-10 Log[(5-2 (Sqrt[5])) y]+10 Log[-1+(Sqrt[5]) y+(Sqrt[1-2 y ((Sqrt[5])+(-5+(Sqrt[5])) y)])])),{y,0,(1/4) (-1+(Sqrt[5]))}]

(ii=((NumericalApproximation[Root, (RowDefault["1.18", FEExpressionsNumericalApproximationElider]), Root[5-5 ((#1)^2)+((#1)^4)&,3], ])/5)(Integrate[ 2 (Sqrt[5]) (Sqrt[9+4 (Sqrt[5])+2 y (-20-9 (Sqrt[5])+(25+11 (Sqrt[5])) y)]),{y,0,(1/4) (-1+(Sqrt[5]))}]-10Integrate[ y (Sqrt[9+4 (Sqrt[5])+2 y (-20-9 (Sqrt[5])+(25+11 (Sqrt[5])) y)]),{y,0,(1/4) (-1+(Sqrt[5]))}]-Integrate[(y^2) (10+6 (Sqrt[5])+Log[3125]-10 Log[(5-2 (Sqrt[5])) y]),{y,0,(1/4) (-1+(Sqrt[5]))}]-10NIntegrate[(y^2) Log[-1+(Sqrt[5]) y+(Sqrt[1-2 y ((Sqrt[5])+(-5+(Sqrt[5])) y)])],{y,0,(1/4) (-1+(Sqrt[5]))}]))//Timing

Plot[(y^2) Log[-1+(Sqrt[5]) y+(Sqrt[1-2 y ((Sqrt[5])+(-5+(Sqrt[5])) y)])],{y,0,(1/4) (-1+(Sqrt[5]))}]

NIntegrate[(y^2) Log[-1+(Sqrt[5]) y+(Sqrt[1-2 y ((Sqrt[5])+(-5+(Sqrt[5])) y)])],{y,0,(1/4) (-1+(Sqrt[5]))}]

Integrate[(y^2) Log[-1+(Sqrt[5]) y+(Sqrt[1-2 y ((Sqrt[5])+(-5+(Sqrt[5])) y)])],{y,0,(1/4) (-1+(Sqrt[5]))}]

N[%]

i=Integrate[(y^2) Log[-1+(Sqrt[5]) y+(Sqrt[1-2 y ((Sqrt[5])+(-5+(Sqrt[5])) y)])],y]

Plot[i,{y,0,(1/4) (-1+(Sqrt[5]))}]

Limit[i,y->(1/4) (-1+(Sqrt[5])),Direction->"FromBelow"]-Limit[i,y->0,Direction->"FromAbove"]

N[%]

di=D[(1/(144 (((-5+(Sqrt[5])))^3)))(-640 (-5+2 (Sqrt[5])) (y^3)+90 (-1+(Sqrt[5])) (Sqrt[1-2 (Sqrt[5]) y-2 (-5+(Sqrt[5])) (y^2)])-120 (-3+(Sqrt[5])) y (Sqrt[1-2 (Sqrt[5]) y-2 (-5+(Sqrt[5])) (y^2)])-3 (5 (Sqrt[5-2 (Sqrt[5])])+5 (Sqrt[5 (5-2 (Sqrt[5]))])+165 (Sqrt[85+38 (Sqrt[5])])-67 (Sqrt[5 (85+38 (Sqrt[5]))])+5 (Sqrt[730+302 (Sqrt[5])])) ArcSinh[(Sqrt[1+(2/(Sqrt[5]))]) ((Sqrt[5])+2 (-5+(Sqrt[5])) y)]+1920 (-5+2 (Sqrt[5])) (y^3) Log[-1+(Sqrt[5]) y+(Sqrt[1-2 y ((Sqrt[5])+(-5+(Sqrt[5])) y)])]),y]

ExpToTrig[(y^2) Log[-1+(Sqrt[5]) y+(Sqrt[1-2 y ((Sqrt[5])+(-5+(Sqrt[5])) y)])]]

Integrate[,{y,0,(1/4) (-1+(Sqrt[5]))}]

(rxy1=10((Integrate[(Sqrt[(x^2)+(y^2)])Boole[ineq2],{y,-∞,∞}])/area)//FullSimplify)//Timing

NIntegrate[rxy1,{x,-∞,∞}]

Solve[(5+(Sqrt[5])) x==(Sqrt[5+2 (Sqrt[5])]),x]//FullSimplify

Plot[rxy1,{x,0,(1/2) (Sqrt[(1/10) (5+(Sqrt[5]))])}]

NIntegrate[y^2 Log[-1+Sqrt[5] y+Sqrt[1-2 y (Sqrt[5]+(-5+Sqrt[5]) y)]],{y,0,(1/4) (-1+(Sqrt[5]))}]

FullSimplify[y^2 Log[-1+Sqrt[5] y+Sqrt[1-2 y (Sqrt[5]+(-5+Sqrt[5]) y)]]/.y->(x/(Sqrt[5]))]

(1/(5(Sqrt[5])))NIntegrate[(x^2) Log[-1+x+(Sqrt[1-(2/5) x (5+(-5+(Sqrt[5])) x)])],{x,0,(1/4) (5-(Sqrt[5]))}]

(1/(5(Sqrt[5])))Integrate[(x^2) Log[-1+x+(Sqrt[1-(2/5) x (5+(-5+(Sqrt[5])) x)])],{x,0,(1/4) (5-(Sqrt[5]))}]

N[%]

f=y^2 Log[-1+Sqrt[5] y+Sqrt[1-2 y (Sqrt[5]+(-5+Sqrt[5]) y)]]

F=Integrate[f,y]

dF=D[F,y]

Plot[dF-f,{y,0,1/4 (-1+Sqrt[5])}]

(rxy=Integrate[rxy1,{x,-∞,∞}])//Timing

N[rxy,20]

Divergence theorem

p=Polyhedron[];

vol=(1/2) (Sqrt[(5/2) (5+(Sqrt[5]))]);

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

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

N[%]

Integrate over Polyhedron

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

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

Divergence theorem

(rxy=MeanSquareCylindricalRadius[p,Debug->False]//FullSimplify)//Timing

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

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

Integrate

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

Divergence theorem

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

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)

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

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"]

((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)//FullSimplify)//Timing

Divergence theorem

(rxy=MeanSquareSphericalRadius[p,Debug->False]//FullSimplify)//Timing

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]((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

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

(sphere=Midsphere[p])//Timing

(sphere=Midsphere[p,Method->"PointLineDistance"])//Timing

Net

PolyhedronData[pname,"Net"]

Total[Area/@Flatten[PolyhedronData[pname,"Net","Polygon"]]]//ToAlgebraicRoot//Timing

PolyhedronData[pname,"SurfaceArea"]

Polygons

PolyhedronData[pname,"FaceCount"]

Graphics3D/@PolyhedronData[pname,"Polygons"]

Show[%]

Polyhedra

PolyhedronData[pname,"Polyhedra"]

Graphics3D[%]

PolyhedronData[pname,"PolyhedronIndices"]

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"]

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

With[{verts=PolyhedronData[pname,"Vertices"],faces=PolyhedronData[pname,"Faces","List"]},
ToCommonEdges[GraphData[gn],Graph[Range[Length[verts]],UndirectedEdge@@@Union[Sort/@Flatten[Partition[#,2,1,1]&/@faces,1]]]]]//Chop[#,1*^-5]&//N

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

RootReduce[%]

SurfaceArea[p]//FullSimplify//Timing

N[%]

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

VertexCount

PolyhedronData[pname,"VertexCount"]

VertexSubsetHulls

subsethulls=PolyhedronData[pname,"VertexSubsetHulls"]

subsethulls2=Flatten[Function[{pn,l},Rule[pn,#]&/@l]@@@subsethulls]

v=PolyhedronData[pname,"Vertices"];

Rule[#,Graphics3D[{{Green,p},Blue,Opacity[.5],ConvexHullRegion[v[[#2]]]}]]&@@@subsethulls2

Platonic

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

Construction

Graphics3D[p]

5-prism, but not equilateral

Graphics3D[hull=ConvexHullRegion[p[[1]]]]

PolyhedronEdgeLengths[hull]//FullSimplify//Quiet//Tally

Sort[hull[[1]]/.MapIndexed[#->#2[[1]]&,p[[1]]]]

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

PolyhedronVolume[p]//FullSimplify

Properties: {"Prism", {6, 2}}

<<MathWorld`Polyhedra`

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

p=Polyhedron[];

vol=PolyhedronData[pname,"Volume"]

vol=3 (Sqrt[3]);

AdjacentFaceIndices

PolyhedronData[pname,"AdjacentFaceIndices"]

%==AdjacentFaceIndices[p]

Centroid

PolyhedronData[pname,"Centroid"]

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

RegionCentroid[p]//FullSimplify//Timing

PolyhedronCentroid[p]//FullSimplify//Quiet//Timing

Circumsphere

sphere=PolyhedronData[pname,"Circumsphere"]

sphere=Circumsphere[p]

(sphere=MyCircumsphere[p])//Timing

Compound

PolyhedronData[pname,"Compound"]

Convex

PolyhedronData[pname,"Convex"]

ConvexPolyhedronQ[p]

ConvexHull

PolyhedronData[pname,"ConvexHull"]

convexhull=ConvexHullRegion[PolyhedronData[pname,"Vertices"]]

v=PolyhedronCoordinates[convexhull]

Sort[(convexhull[[2]]/.i_Integer:>v[[i]])/.Thread[PolyhedronData[pname,"Vertices"]->Range[PolyhedronData[pname,"V"]]]]

Graphics3D[{FaceForm[Green,Red],convexhull,MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

EuclideanDistance@@v[[{7,8}]]//FullSimplify

N[%]

EuclideanDistance@@v[[{5,8}]]//FullSimplify

{Graphics3D[{Red,Opacity[.5],p}],Graphics3D[{Blue,Opacity[.5],PolyhedronData[pname,"ConvexHull"][[1]]}]}

Show[%]

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[convexhull]]//Tally

N[%]

Graphics3D[{p,MapIndexed[Text[#2[[1]],#,Background->White]&,p[[1]]]}]

DihedralAngles

PolyhedronData[pname,"DihedralAngles"]

SimplifyNumericallyDistinct[DihedralAngles[p]]==%

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"]

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[p]//FullSimplify//Quiet

Hull

PolyhedronData[pname,"Hull","Name"]

PolyhedronData[pname,"Hull","Scale"]

PolyhedronData[pname,"Hull"]

{Graphics3D[{Opacity[.5],Red,p}],Graphics3D[{Opacity[.5],Blue,PolyhedronData[pname,"Hull"][[1]]}]}

Show[%]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

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

PolyhedronInertiaTensor[p]//Timing

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[p]

sphere=MyInsphere[N[p,20]]

sphere=MyInsphere[p]

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

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

N[%]

Integrate over polyhedron

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

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

2D

poly=Polygon[PolyhedronData[pname,"Polygons"][[-1,1,All,;;2]]]

Graphics[{poly,MapIndexed[Text[#2[[1]],#,Background->White]&,poly[[1]]]}]

(area=Integrate[1,{x,y}∈poly]//FullSimplify)//Timing

((NIntegrate[(Sqrt[(x^2)+(y^2)]),{x,y}∈poly])/area)

halfkite=Polygon[Append[poly[[1]][[{1,12}]],{0,0}]]

%//InputForm

12((NIntegrate[(Sqrt[(x^2)+(y^2)]),{x,y}∈halfkite])/area)

(rxy=12((Integrate[(Sqrt[(x^2)+(y^2)]),{x,y}∈halfkite])/area)//FullSimplify)//Timing

N[rxy]

Divergence theorem

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

N[rxy]

(rxysimp=FullSimplify[rxy])//Timing

N[rxysimp]

rxysimp=(1/165888)(-3 (5301+64 (Sqrt[3])) Log[3]+48 (Sqrt[3]) Log[9863382151-5694626340 (Sqrt[3])]+16 (243+7 (Sqrt[3])) Log[1351-780 (Sqrt[3])]+6 (36 (-3+(Sqrt[3])) Log[7-4 (Sqrt[3])]-8 (324+151 (Sqrt[3])) Log[2-(Sqrt[3])]+(6291-944 (Sqrt[3])) Log[2+(Sqrt[3])]-1296 Log[-3+2 (Sqrt[3])]+(-135+64 (Sqrt[3])) Log[3+2 (Sqrt[3])]+36 (-128+384 (Sqrt[3])-5 Log[-45+26 (Sqrt[3])])));

N[rxysimp]

N[rxysimp,20]

bug(431647): N[log expr] returns Indeterminate

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)

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

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,zmin,zmax}])//Timing

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

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

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

N[%]

Integrate over Polyhedron

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

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

Divergence theorem

(rxy=MeanSquareCylindricalRadius[p,Debug->False]//FullSimplify)//Timing

MeanSphericalRadius

PolyhedronData[pname,"MeanSphericalRadius"]

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

Integrate

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

Divergence theorem

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

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)

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

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"]

((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)//FullSimplify)//Timing

Divergence theorem

(rxy=MeanSquareSphericalRadius[p,Debug->False]//FullSimplify)//Timing

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]((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

Midsphere

sphere=PolyhedronData[pname,"Midsphere"]

(sphere=Midsphere[p])//Timing

(sphere=Midsphere[p,Method->"PointLineDistance"])//Timing

Net

PolyhedronData[pname,"Net"]

Total[Area/@Flatten[PolyhedronData[pname,"Net","Polygon"]]]//ToAlgebraicRoot//Timing

PolyhedronData[pname,"SurfaceArea"]

Polygons

PolyhedronData[pname,"FaceCount"]

Graphics3D/@PolyhedronData[pname,"Polygons"]

Show[%]

Polyhedra

PolyhedronData[pname,"Polyhedra"]

Graphics3D[%]

PolyhedronData[pname,"PolyhedronIndices"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

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

RegionPlot3D[reg,{x,-2,2},{y,-2,2},{z,-1,1},PlotPoints->50]

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

FullSimplify[%]

SimplePolyhedron

PolyhedronData[pname,"Simple"]

SimplePolyhedronQ[p]

Skeleton

PolyhedronData[pname,"Skeleton"]

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

With[{verts=PolyhedronData[pname,"Vertices"],faces=PolyhedronData[pname,"Faces","List"]},
ToCommonEdges[GraphData[gn],Graph[Range[Length[verts]],UndirectedEdge@@@Union[Sort/@Flatten[Partition[#,2,1,1]&/@faces,1]]]]]//Chop[#,1*^-5]&//N

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[p]//FullSimplify//Timing

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

VertexCount

PolyhedronData[pname,"VertexCount"]

VertexSubsetHulls

subsethulls=PolyhedronData[pname,"VertexSubsetHulls"]

subsethulls2=Flatten[Function[{pn,l},Rule[pn,#]&/@l]@@@subsethulls]

v=PolyhedronData[pname,"Vertices"];

Rule[#,Graphics3D[{{Green,Opacity[.2],p},Blue,Opacity[.5],ConvexHullRegion[v[[#2]]]}]]&@@@subsethulls2

Platonic

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

Volume

PolyhedronData[pname,"Volume"]

Volume[p]//FullSimplify

PolyhedronVolume[p]//FullSimplify

Construction

{5/2}

R=With[{ρ=(Sqrt[((5-(Sqrt[5]))/10)]),a=(1/2)(3-(Sqrt[5]))},(ρ/a)]//FullSimplify

r=With[{RR=(Sqrt[(1/10)(25-11(Sqrt[5]))]),a=(1/2)(3-(Sqrt[5]))},(RR/a)]//FullSimplify

v=Flatten[{
Table[Append[#,z/2]&/@CirclePoints[{R,Pi/2},5],{z,{-1,1}}],
Table[Append[#,z/2]&/@CirclePoints[{r,-Pi/2},5],{z,{-1,1}}]
},
2]//FullSimplify

pentagram={1,14,2,15,3,11,4,12,5,13};

top=Partition[pentagram,2,1,1]

bot=Reverse/@Partition[pentagram+5,2,1,1]

squares=Join@@@Transpose[{top,bot}]

faces=Join[
{Reverse@pentagram,pentagram+5},
squares
]

Graphics3D[{FaceForm[Green,Red],p=Polyhedron[v,faces],MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

PolyhedronEdgeLengths[p]//FullSimplify//Union//Quiet

Rotate by -Pi/2:

RotationMatrix[-Pi/2,{0,0,1}].#&/@{{0,(Sqrt[1+(2/(Sqrt[5]))]),-(1/2)},{(1/4) (-3-(Sqrt[5])),(1/4) (Sqrt[2+(2/(Sqrt[5]))]),-(1/2)},{(1/4) (-1-(Sqrt[5])),-(1/4) (Sqrt[10+(22/(Sqrt[5]))]),-(1/2)},{(1/4) (1+(Sqrt[5])),-(1/4) (Sqrt[10+(22/(Sqrt[5]))]),-(1/2)},{(1/4) (3+(Sqrt[5])),(1/4) (Sqrt[2+(2/(Sqrt[5]))]),-(1/2)},{0,(Sqrt[1+(2/(Sqrt[5]))]),(1/2)},{(1/4) (-3-(Sqrt[5])),(1/4) (Sqrt[2+(2/(Sqrt[5]))]),(1/2)},{(1/4) (-1-(Sqrt[5])),-(1/4) (Sqrt[10+(22/(Sqrt[5]))]),(1/2)},{(1/4) (1+(Sqrt[5])),-(1/4) (Sqrt[10+(22/(Sqrt[5]))]),(1/2)},{(1/4) (3+(Sqrt[5])),(1/4) (Sqrt[2+(2/(Sqrt[5]))]),(1/2)},{0,(NumericalApproximation[Root, (RowDefault["-0.526", FEExpressionsNumericalApproximationElider]), Root[1-5 ((#1)^2)+5 ((#1)^4)&,2], ]),-(1/2)},{(1/2),-(1/2) (Sqrt[1-(2/(Sqrt[5]))]),-(1/2)},{(1/4) (-1+(Sqrt[5])),(1/2) (Sqrt[(1/10) (5+(Sqrt[5]))]),-(1/2)},{(1/4) (1-(Sqrt[5])),(1/2) (Sqrt[(1/10) (5+(Sqrt[5]))]),-(1/2)},{-(1/2),-(1/2) (Sqrt[1-(2/(Sqrt[5]))]),-(1/2)},{0,(NumericalApproximation[Root, (RowDefault["-0.526", FEExpressionsNumericalApproximationElider]), Root[1-5 ((#1)^2)+5 ((#1)^4)&,2], ]),(1/2)},{(1/2),-(1/2) (Sqrt[1-(2/(Sqrt[5]))]),(1/2)},{(1/4) (-1+(Sqrt[5])),(1/2) (Sqrt[(1/10) (5+(Sqrt[5]))]),(1/2)},{(1/4) (1-(Sqrt[5])),(1/2) (Sqrt[(1/10) (5+(Sqrt[5]))]),(1/2)},{-(1/2),-(1/2) (Sqrt[1-(2/(Sqrt[5]))]),(1/2)}}//FullSimplify//ToRadicals

PolyhedronData

PolyhedronData[{"Prism",{6,2}},"Name"]

PolyhedronData["Prism"]

PolyhedronDataString

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

WriteString[file,PolyhedronDataString[
p,
"StandardName"->{"Prism",{5,2}},
"Name"->"(5,2)\[Hyphen]polygrammic prism",
"Information"->"PolygrammicPrism",
Debug->True
]]

Close[file]