Augmentation

Author

Eric W. Weisstein
December 14, 2018

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

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

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

Cumulation series

GraphicsArray

GraphicsGrid[Table[Graphics3D[AugmentedPolyhedron[PolyhedronData[poly,"Polyhedron"],h],Boxed->False,Method->{"ShrinkWrap"->True}],{poly,PolyhedronData["Platonic"]},{h,-1,2,.4}],ImageSize->500,Spacings->100]

Manipulate

Manipulate[Graphics3D[AugmentedPolyhedron[PolyhedronData[poly,"Polyhedron"],h],Boxed->False,Method->{"ShrinkWrap"->True}],{poly,PolyhedronData["Platonic"]},{h,-1,2}]

Cumulation height checks

Cube 0 -> cube

Graphics3D[poly=AugmentedPolyhedron[PolyhedronData["Cube","Polyhedron"],0]]

Cube 1/4 -> tetrakis hexahedron

Graphics3D[poly=AugmentedPolyhedron[PolyhedronData["Cube","Polyhedron"],1/4],Boxed->False,Method->{"ShrinkWrap"->True}]

v=poly[[1]];
f=poly[[2]];

e=Union[Sort/@Flatten[Partition[#,2,1,1]&/@f,1]]

EuclideanDistance@@@(v[[#]]&/@e)//Union

PolyhedronData["TetrakisHexahedron","EdgeLengths"]

Cube 1/2 -> rhombic dodecahedron

Graphics3D[poly=AugmentedPolyhedron[PolyhedronData["Cube","Polyhedron"],1/2],Boxed->False,Method->{"ShrinkWrap"->True}]

v=poly[[1]];
f=poly[[2]];

e=Union[Sort/@Flatten[Partition[#,2,1,1]&/@f,1]]

EuclideanDistance@@@(v[[#]]&/@e)//Union

PolyhedronData["RhombicDodecahedron","EdgeLengths"]

Cube 1/(Sqrt[2]) -> cumulated cube

Graphics3D[poly=AugmentedPolyhedron[PolyhedronData["Cube","Polyhedron"],(Sqrt[2])/2],Boxed->False,Method->{"ShrinkWrap"->True}]

v=poly[[1]];
f=poly[[2]];

e=Union[Sort/@Flatten[Partition[#,2,1,1]&/@f,1]]

EuclideanDistance@@@(v[[#]]&/@e)//Union

PolyhedronData["CumulatedCube","EdgeLengths"]

Icosahedron (Sqrt[6])/3 -> equilateral cumulated icosahedron

(Sqrt[6])/3.

Graphics3D[poly=AugmentedPolyhedron[PolyhedronData["Icosahedron","Polyhedron"],(Sqrt[6])/3],Boxed->False,Method->{"ShrinkWrap"->True}]

v=poly[[1]];
f=poly[[2]];

e=Union[Sort/@Flatten[Partition[#,2,1,1]&/@f,1]]

FullSimplify[SquaredEuclideanDistance@@@(v[[#]]&/@e)]//Union

PolyhedronData["CumulatedIcosahedron","EdgeLengths"]

Icosahedron 1 -> *non*equilateral cumulated icosahedron

Graphics3D[poly=AugmentedPolyhedron[PolyhedronData["Icosahedron","Polyhedron"],1],Boxed->False,Method->{"ShrinkWrap"->True}]

v=poly[[1]];
f=poly[[2]];

e=Union[Sort/@Flatten[Partition[#,2,1,1]&/@f,1]]

(lengths=FullSimplify[EuclideanDistance@@@(vertices[[#]]&/@edges)]//Union)//Timing

N[lengths]

Table

cum={
"Cube"->{1/4,1/2,(Sqrt[2])/2},
"Dodecahedron"->{1/19(Sqrt[(1/5)(65+22(Sqrt[5]))]),(Sqrt[(1/10)(5-(Sqrt[5]))]),(Sqrt[(1/5)(5+2(Sqrt[5]))])},
"Icosahedron"->{(1/6)(Sqrt[3])((Sqrt[5])-(Sqrt[3])),(Sqrt[15])/15,(Sqrt[6])/3,(Sqrt[3])(3+(Sqrt[5]))/6},
"Octahedron"->{(Sqrt[3])-(2/3)(Sqrt[6]),(Sqrt[6])/3},
"Tetrahedron"->{(Sqrt[6])/15,(Sqrt[6])/6,(Sqrt[6])/3}
};

GraphicsGrid[Table[Graphics3D[Cumulate[Flatten@Normal@PolyhedronData[poly[[1]],"GraphicsComplex"],#],Boxed->False,Method->{"ShrinkWrap"->True},PlotLabel->Column[{Style[PolyhedronData[poly[[1]],"Name"],Italic],Row[{Style["h",Italic],"==",N[#]}]},Alignment->Center],LabelStyle->Directive[8,FontFamily->"Times"]]&/@Prepend[poly[[2]],0],{poly,cum}],
Dividers->All,ImageSize->500]