Chamfered Octahedron

Author

Eric W. Weisstein
October 6, 2022

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

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

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

Graphic

Varying chamfering ratios

With[{p=Octahedron[]},GraphicsRow[Graphics3D[{Opacity[.8],#},Boxed->False]&/@Prepend[Table[ResourceFunction["ChamferedPolyhedron"][p,r],{r,.2,.99,.2}],p]]]

Graphics3D[{Opacity[.7],PolyhedronData["EquilateralChamferedOctahedron","Polyhedron"]},Boxed->False]

Graphics3D[{FaceForm[Green,Red],PolyhedronData["EquilateralChamferedOctahedron","Polyhedron"]},Boxed->False]

Net

PolyhedronData["EquilateralChamferedOctahedron","Net"]

PolyhedronData["EquilateralChamferedOctahedron","Net","Colored"]

As the Al Rihla soccer ball

From P. Kuchel
Communicated Aug 16, 2022

https://community.wolfram.com/groups/-/m/t/2603714

Al Rihla is Adidas’ name for their football released for the 2022 FIFA World Cup (in Qatar). It has a pattern of shaped panels, and intersecting grooves that are distinctly different from its 13 predecessors.

A		                            B
    
FIGURE 1. Adidas’ Al Rihla footballs. A, The Match Ball; and B, the Club or Practice Ball.

As for previous releases, the cheaper Club Ball variant that has stitched seams on panels that are of different shape from those of the Match Ball; the Match Ball having mostly molded seams. Nevertheless, the printed patterns (decals) are the same on both types, consequently straight lines on the Club Ball cross the stitched seams; whereas on the Match Ball they are coincident with the seams.

By simple inspection, it is evident that the Club Ball (Figure 1B) has 12 congruent faces that are isosceles pentagons. Four sides of each pentagon are of equal length and longer than the  fifth side that is shorter by a factor of more that 2. Such a polyhedron is therefore a dodecahedron that can be simply morphed into the regular dodecahedron. In other words Al Rihla’s polyhedron is isomorphic with the regular dodecahedron.

Properties

<<MathWorld`Polyhedra`

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

vol=PolyhedronData[pname,"Volume"]

Centroid

PolyhedronData[pname,"Centroid"]

(xbar=RegionCentroid[poly]//FullSimplify)//Timing

PolyhedronCentroid[poly]//FullSimplify//Quiet//Timing

Circumsphere

PolyhedronData[pname,"Circumsphere"]

Circumsphere[poly]//Timing

MyCircumsphere[poly]//Timing

EdgeLengths

PolyhedronData[pname,"EdgeLengths"]

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[poly]]//Quiet//Union

PolyhedronEdgeLengths[poly]//RootReduce//Union//Quiet//Timing

GeneralizedDiameter

PolyhedronData[pname,"GeneralizedDiameter"]

GeneralizedDiameter[poly]//FullSimplify//Quiet

RootReduce[%]

FullSimplify[%]

InertiaTensor

PolyhedronData[pname,"InertiaTensor"]

(i=MomentOfInertia[poly,{0,0,0}])//Timing

(ii=Map[ToAlgebraicRoot,i,{2}])//Quiet//Timing

iii=RootReduce[(ii/vol)]//FullSimplify

N[iii]

Equal@@Tr[iii,List]

(i=PolyhedronInertiaTensor[poly,vol])//Timing

Insphere

PolyhedronData[pname,"Insphere"]

Insphere[poly]//Timing

MyInsphere[poly]//Timing

MeanCylindricalRadius

PolyhedronData[pname,"MeanCylindricalRadius"]

Integrate over polyhedron

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

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

Divergence theorem

(rxy=MeanCylindricalRadius[p,Debug->True])//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)

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

Inequalities

{{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}])//Timing

N[i2]

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

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

MeanSquareCylindricalRadius

PolyhedronData[pname,"MeanSquareCylindricalRadius"]

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

MeanSquareCylindricalRadius[p,Debug->True]//FullSimplify//Timing

MeanSquareSphericalRadius

PolyhedronData[pname,"MeanSquareSphericalRadius"]

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

MeanSquareSphericalRadius[p,Debug->True]//FullSimplify//Timing

Midsphere

PolyhedronData[pname,"Midsphere"]

Midsphere[poly]//Timing

Midsphere[poly,Method->"PointLineDistance","SolveMethod"->"NSolve"]//Timing

Net

PolyhedronData[pname,"Net"]

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

PolyhedronData[pname,"SurfaceArea"]

Region

PolyhedronData[pname,"Region"]

RegionFunction

ineq=Collect[#,{x,y,z},RootReduce]&/@PolyhedronInequalities[poly,{x,y,z}]

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

FullSimplify/@%

FullSimplify@%

Skeleton

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

With[{gn="ChamferedOctahedralGraph",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]]]]]//FullSimplify

PolyhedronData[pname,"Skeleton"]

%//RecognizeGraph

SurfaceArea

PolyhedronData[pname,"SurfaceArea"]

SurfaceArea[poly]//ToAlgebraicRoot//FullSimplify//Quiet//Timing

PolyhedronSurfaceArea[poly]//RootReduce//FullSimplify//Timing

Volume

PolyhedronData[pname,"Volume"]

Volume[poly]//RootReduce//Timing

Volume[poly]//RootReduce//FullSimplify

PolyhedronVolume[poly]//ToAlgebraicRoot//Quiet//Timing

Volume[PolyhedronData[pname,"Region"]]//RootReduce//FullSimplify//Timing

Volume[PolyhedronData[pname,"Region"]]//ToAlgebraicRoot//FullSimplify//Timing

Net construction

PolyhedronEdgeLengths[PolyhedronData["EquilateralChamferedOctahedron","Polyhedron"]]//RootReduce//Union//Quiet//Timing

PolyhedronData["EquilateralChamferedOctahedron","FaceCountRules"]

Graphics3D[{poly=PolyhedronData["EquilateralChamferedOctahedron","Polyhedron"],MapIndexed[Text[#2[[1]],#,Background->White]&,v=PolyhedronData["EquilateralChamferedOctahedron","VertexCoordinates"]]}]

l=EuclideanDistance@@v[[{5,6}]]//FullSimplify

h=EuclideanDistance@@v[[{8,22}]]//FullSimplify

g=Graphics[{EdgeForm[Black],FaceForm[White],p=Polygon[{{0,0},{l-1,-h}/2,{l+1,-h}/2,{l,0},{l+1,h}/2,{l-1,h}/2}]}]

tri=RegularPolygon[Csc[Pi/3]/2,3]

Rotate[Graphics[{EdgeForm[Black],FaceForm[White],
Table[Translate[p,{l x,h y}],{x,0,3},{y,0,2}],
Table[Translate[tri,{.5+x,4+y}],{x,0,1},{y,0,3}]
}],Pi/2]

PolygonAngle[p]//FullSimplify

hex={5,8,7,4,16,18};

Graphics3D[Polygon[v[[hex]]]]

(ang=ArcCos[ToAlgebraicRoot/@Cos[PolygonAngle[Polygon[v[[hex]]]]]])//Quiet//FullSimplify//Timing

N[ang]

{α=ArcSec[3],β=ArcCos[-(Sqrt[(2/3)])]}

m=RotationMatrix;
v={{-l/2,0},{l/2,0},{-1/2,h/2},{-1/2,-h/2},{1/2,h/2},{1/2,-h/2},{0,h/2+Sqrt[3]/2},-{0,h+Sqrt[3]}/2};
v=Join[v,{v[[7]]+m[β].(v[[5]]-v[[7]]),v[[7]]+m[-β].(v[[3]]-v[[7]]),v[[5]]+m[-β].(v[[7]]-v[[5]]),v[[3]]+m[β].(v[[7]]-v[[3]])}];
v=Join[v,{v[[11]]+m[-α].(v[[5]]-v[[11]]),v[[9]]+m[α].(v[[7]]-v[[9]])}]//FullSimplify;
v=Join[v,{-#,#2}&@@@v[[{11,13,14}]]];
v=Join[v,{v[[13]]+m[-Pi/3].(v[[14]]-v[[13]]),v[[14]]+m[-β].(v[[9]]-v[[14]]),v[[9]]+m[α].(v[[14]]-v[[9]])}];
v=Join[v,{v[[20]]+m[β].(v[[9]]-v[[20]]),v[[19]]+m[-β].(v[[14]]-v[[19]])}];
v=Join[v,{-#,#2}&@@@v[[{19,22,21,20}]]];
v=Join[v,{v[[20]]+m[Pi/3].(v[[21]]-v[[20]]),v[[22]]+m[-α].(v[[21]]-v[[22]]),v[[21]]+m[β].(v[[22]]-v[[21]])}];
v=Join[v,{v[[29]]+m[β].(v[[21]]-v[[29]])}];
v=Join[v,{v[[30]]+m[α].(v[[29]]-v[[30]]),v[[16]]+m[Pi/3].(v[[17]]-v[[16]])}];
v=Join[v,{#,-#2}&@@@v[[{9,14,13,11,10,17,16,15}]]];
v=Join[v,{v[[34]]+m[-Pi/3].(v[[35]]-v[[34]])}];
v=Join[v,{v[[35]]+m[β].(v[[41]]-v[[35]]),v[[41]]+m[-β].(v[[35]]-v[[41]])}];
v=Join[v,{v[[42]]+m[α].(v[[35]]-v[[42]]),v[[43]]+m[-α].(v[[41]]-v[[43]])}];
v=Join[v,{v[[34]]+m[-β].(v[[41]]-v[[34]]),v[[41]]+m[β].(v[[34]]-v[[41]])}];
v=Join[v,{v[[46]]+m[-α].(v[[34]]-v[[46]]),v[[47]]+m[α].(v[[41]]-v[[47]])}];
v=Join[v,{-#,#2}&@@@v[[{42,44,45,43,41,35,34,46,48,49,47}]]];
v=Join[v,{v[[59]]+m[-π/3].(v[[58]]-v[[59]])}]//FullSimplify;
f=Sort@{{2,5,3,1,4,6},{5,7,3},{6,4,8},{11,13,14,9,7,5},{7,10,17,16,15,3},{18,14,13},{22,21,20,9,14,19},{10,26,25,24,23,17},{21,27,20},{28,31,30,29,21,22},{17,32,16},{36,6,8,33,34,35},{4,40,39,38,37,8},{35,34,41},{45,44,42,35,41,43},{47,41,34,46,48,49},{55,50,51,52,53,54},{56,55,54},{54,60,59,58,57,56},{58,59,61}};
Graphics[{FaceForm[LightYellow,Red],EdgeForm[Black],Polygon[v,f],MapIndexed[Text[#2[[1]],#,Background->White]&,v]}]

Tally[Length/@f]

GraphicsGrid[Partition[Graphics[{FaceForm[LightYellow,Red],EdgeForm[Black],Polygon[v,#]}]&/@f,5]]

v

{{(1/6) (-3-2 (Sqrt[6])),0},{(1/2)+(Sqrt[(2/3)]),0},{-(1/2),(1/(Sqrt[3]))},{-(1/2),-(1/(Sqrt[3]))},{(1/2),(1/(Sqrt[3]))},{(1/2),-(1/(Sqrt[3]))},{0,(5/(2 (Sqrt[3])))},{0,-(5/(2 (Sqrt[3])))},{(1/2)-(1/(Sqrt[6])),(1/(Sqrt[2]))+(Sqrt[3])},{-(1/2)+(1/(Sqrt[6])),(1/(Sqrt[2]))+(Sqrt[3])},{1+(1/(Sqrt[6])),(1/2) (-(Sqrt[2])+(Sqrt[3]))},{-1-(1/(Sqrt[6])),(1/2) (-(Sqrt[2])+(Sqrt[3]))},{(3/2),(2/(Sqrt[3]))},{1,(7/(2 (Sqrt[3])))},{-1-(1/(Sqrt[6])),(1/2) (-(Sqrt[2])+(Sqrt[3]))},{-(3/2),(2/(Sqrt[3]))},{-1,(7/(2 (Sqrt[3])))},{2,(7/(2 (Sqrt[3])))},{(7/6)+(Sqrt[(2/3)]),((Sqrt[2])/3)+(Sqrt[3])},{-(2/9) (-6+(Sqrt[6])),((2 (Sqrt[2]))/3)+(23/(6 (Sqrt[3])))},{(1/18) (27+2 (Sqrt[6])),(Sqrt[2])+(10/(3 (Sqrt[3])))},{2+(5/(3 (Sqrt[6]))),(1/(Sqrt[2]))+(23/(6 (Sqrt[3])))},{(1/6) (-7-2 (Sqrt[6])),((Sqrt[2])/3)+(Sqrt[3])},{-2-(5/(3 (Sqrt[6]))),(1/(Sqrt[2]))+(23/(6 (Sqrt[3])))},{(1/18) (-27-2 (Sqrt[6])),(Sqrt[2])+(10/(3 (Sqrt[3])))},{(2/9) (-6+(Sqrt[6])),((2 (Sqrt[2]))/3)+(23/(6 (Sqrt[3])))},{(1/9) (15-2 (Sqrt[6])),((4 (Sqrt[2]))/3)+(23/(6 (Sqrt[3])))},{(1/18) (45+2 (Sqrt[6])),(Sqrt[2])+(13/(3 (Sqrt[3])))},{(1/9) (9+(Sqrt[6])),(Sqrt[2])+(29/(6 (Sqrt[3])))},{(3/2)-(1/(3 (Sqrt[6]))),(3/(Sqrt[2]))+(16/(3 (Sqrt[3])))},{(1/9) (18+(Sqrt[6])),(Sqrt[2])+(35/(6 (Sqrt[3])))},{-2,(7/(2 (Sqrt[3])))},{(1/2)-(1/(Sqrt[6])),-(Sqrt[(7/2)+(Sqrt[6])])},{1,-(7/(2 (Sqrt[3])))},{(3/2),-(2/(Sqrt[3]))},{1+(1/(Sqrt[6])),(1/(Sqrt[2]))-((Sqrt[3])/2)},{-(1/2)+(1/(Sqrt[6])),-(Sqrt[(7/2)+(Sqrt[6])])},{-1,-(7/(2 (Sqrt[3])))},{-(3/2),-(2/(Sqrt[3]))},{-1-(1/(Sqrt[6])),(1/(Sqrt[2]))-((Sqrt[3])/2)},{2,-(7/(2 (Sqrt[3])))},{2-(1/(Sqrt[6])),(1/(Sqrt[2]))-((Sqrt[3])/2)},{(5/2)+(1/(Sqrt[6])),-(Sqrt[(7/2)+(Sqrt[6])])},{(5/2),-(1/(Sqrt[3]))},{3,-(5/(2 (Sqrt[3])))},{1-(Sqrt[(2/3)]),-((3 (Sqrt[3]))/2)},{2+(Sqrt[(2/3)]),-((3 (Sqrt[3]))/2)},{1,-(11/(2 (Sqrt[3])))},{2,-(11/(2 (Sqrt[3])))},{-2+(1/(Sqrt[6])),(1/(Sqrt[2]))-((Sqrt[3])/2)},{-(5/2),-(1/(Sqrt[3]))},{-3,-(5/(2 (Sqrt[3])))},{-(5/2)-(1/(Sqrt[6])),-(Sqrt[(7/2)+(Sqrt[6])])},{-2,-(7/(2 (Sqrt[3])))},{-(3/2),-(2/(Sqrt[3]))},{-1,-(7/(2 (Sqrt[3])))},{-1+(Sqrt[(2/3)]),-((3 (Sqrt[3]))/2)},{-1,-(11/(2 (Sqrt[3])))},{-2,-(11/(2 (Sqrt[3])))},{-2-(Sqrt[(2/3)]),-((3 (Sqrt[3]))/2)},{-(3/2),-(7/(Sqrt[3]))}}//Length

Select[Split[Sort[v]],Length[#]>1&][[All,1]]

Position[v,#]&/@%

SameQ@@v[[#]]&/@{{39,55},{38,56},{12,15}}

f

$Version

bug(426316): Area[Polygon[v, f]] returns wrong result

Area[Polygon[v,f]]//FullSimplify

Area[Polygon[v,f]]//RootReduce//FullSimplify

...wrong...

Total[Area[Polygon[v,#]]&/@f]//RootReduce//FullSimplify

...correct...

Tally[Area[Polygon[v,#]]&/@f//RootReduce//FullSimplify]

PolyhedronData["EquilateralChamferedOctahedron","SurfaceArea"]

SurfaceArea[PolyhedronData["EquilateralChamferedOctahedron","Polyhedron"]]//RootReduce//FullSimplify

polys=Normal[Polygon[v,#]]&/@f

polys[[1]]//InputForm

v=Union@@polys[[All,1]]

Length[v]

f=Sort[polys[[All,1]]/.Thread[v->Range[Length[v]]]]

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

Area[Polygon[v,f]]//FullSimplify

Total[Area[Polygon[v,#]]&/@f]//FullSimplify

Construction

Mangaldan

from Jan Mangaldan, July 2022

EquilateralChamferedOctahedron=Polyhedron[];

Weisstein

f[p_,r_?NumericQ]:=Module[{e=PolyhedronEdgeLengths[ChamferedPolyhedron[p,r]]},Divide@@MinMax[e]]

data=Table[{r,f[Octahedron[],r]},{r,.1,.9,.01}]

ListPlot[data]

peakpos=FindPeaks[data[[All,2]]]

peaks=data[[peakpos[[All,1]]]]

ListLinePlot[
{data,peaks},
Joined->{True,False},
PlotStyle->{Automatic,PointSize[.03]}
]

({r}=FindArgMax[f[Octahedron[],r],{r,8/10,82/100},WorkingPrecision->100])//Timing

rexact=ToAlgebraicRoot[N[r,50]]

Graphics3D[p=ChamferedPolyhedron[Octahedron[],rexact]]

SimplifyNumericallyDistinct[PolyhedronEdgeLengths[p]]//Union//Quiet

GraphData

GraphDataString

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

WriteString[file,PolyhedronDataString[EquilateralChamferedOctahedron,
"StandardName"->"EquilateralChamferedOctahedron",
"Name"->"equilateral chamfered octahedron",
"AlternateStandardNames"->{}
]]