Spikey

Author

Eric W. Weisstein
April 16, 2019

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

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

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

Mathematica

Import

size=100;

v[1]=Show[,ImageSize->size]

v[2]=Show[Import["http://blog.wolfram.com/images/Version2.gif"],ImageSize->size]

v[3]=Show[Import["http://blog.wolfram.com/images/Version3.gif"],ImageSize->size]

v[4]=Show[Import["http://blog.wolfram.com/images/m4.gif"],ImageSize->size]

v[5]=Show[Import["http://blog.wolfram.com/images/m5.gif"],ImageSize->size]

v[6]=Show[Import["http://blog.wolfram.com/images/m6.gif"],ImageSize->size]

v[7]=Show[Import["http://media.wolfram.com/logos/images/m7_spikey.png"],ImageSize->size]

v[8]=Missing

v[9]=Missing

v[10]=Show[ImageCrop@Import["http://media.wolfram.com/logos/images/mathematica-10-spikey.png"],ImageSize->size]

v[11]=Show[ImageCrop@Import["http://company.wolfram.com/data/press-center/uploads/2016/07/mathematica-11-spikey.png"],ImageSize->size]

v[12]=Show[ImageCrop@Import["https://wpmedia.wolfram.com/uploads/sites/10/2019/04/mathematica-12-spikey.png"],ImageSize->size]

List

spikeys={
,,,,,,,,,,,
};

Head/@spikeys

ImageDimensions/@spikeys

grid=GraphicsGrid[Partition[MapIndexed[
Show[ImageCrop[#1],ImageSize->200,PlotLabel->"Version "<>ToString[#2[[1]]]]&,
spikeys
],UpTo[4]],ImageSize->400,Alignment->Top]

Export["/www/sites/mathworld.wolfram.com/htdocs/images/gifs/SpikeyVersions.gif",grid]

ImageDimensions[grid]

Import["/www/sites/mathworld.wolfram.com/htdocs/images/entries/mathematica.gif"]

ImageDimensions[%]

Export["/www/sites/mathworld.wolfram.com/htdocs/images/entries/mathematica.gif",Show[ImageCrop[v[12]],ImageSize->16]]

new=Import["/www/sites/mathworld.wolfram.com/htdocs/images/entries/mathematica.gif"]

ImageDimensions[%]

ImageCrop[new]//ImageDimensions

new2=ImagePad[ImageCrop[new],{{1,1},{1,0}},White]

ImageDimensions[%]

Export["/www/sites/mathworld.wolfram.com/htdocs/images/entries/mathematica.gif",new2]

Import["/www/sites/mathworld.wolfram.com/htdocs/images/entries/mathematica.gif"]

ImageDimensions[%]

V1 Spikey

Solid

PolyhedronData["Spikey","StandardName"]

PolyhedronData["Spikey"]

LiveGraphics3D

WriteLiveForm["spiky.m"Graphics3D[Polyhedron[Spiky],Boxed->False]]

Net

PolyhedronData["Spikey","NetImage"]

Construction

l=Show[Graphics[{Line[{{1497,-12818.8},{2743,-13538.8}}],Line[{{2743,-13538.8},{2743,-12098.8}}],Line[{{2743,-12098.8},{1497,-12818.8}}],Line[{{1497,-14258.8},{1497,-12818.8}}],Line[{{2743,-13538.8},{1497,-14258.8}}],Line[{{1497,-12818.8},{2743,-13538.8}}],Line[{{2743,-13538.8},{3988,-12818.8}}],Line[{{3988,-12818.8},{2743,-12098.8}}],Line[{{2743,-12098.8},{3988,-12818.8}}],Line[{{3988,-11378.8},{2743,-12098.8}}],Line[{{5234,-12098.8},{3988,-11378.8}}],Line[{{3988,-11378.8},{5234,-10658.8}}],Line[{{5234,-10658.8},{5234,-12098.8}}],Line[{{3988,-12818.8},{5234,-12098.8}}],Line[{{3988,-11378.8},{3988,-12818.8}}],Line[{{5234,-12098.8},{3988,-11378.8}}],Line[{{1497,-11378.8},{2743,-12098.8}}],Line[{{1497,-12818.8},{1497,-11378.8}}],Line[{{1497,-12818.8},{1497,-11378.8}}],Line[{{2743,-10658.8},{1497,-11378.8}}],Line[{{2743,-12098.8},{2743,-10658.8}}],Line[{{1497,-9938.75},{2743,-10658.8}}],Line[{{1497,-11378.8},{1497,-9938.75}}],Line[{{5234,-13538.8},{5234,-12098.8}}],Line[{{5234,-12098.8},{3988,-12818.8}}],Line[{{3988,-14258.8},{3988,-12818.8}}],Line[{{3988,-14258.8},{3988,-12818.8}}],Line[{{3988,-12818.8},{5234,-13538.8}}],Line[{{3988,-14258.8},{5234,-14978.8}}],Line[{{5234,-13538.8},{3988,-14258.8}}],Line[{{5234,-14978.8},{5234,-13538.8}}],Line[{{3988,-14258.8},{5234,-14978.8}}],Line[{{7726,-12098.8},{8972,-12818.8}}],Line[{{8972,-12818.8},{8972,-11378.8}}],Line[{{8972,-11378.8},{7726,-12098.8}}],Line[{{7726,-12098.8},{8972,-12818.8}}],Line[{{7726,-10658.8},{8972,-11378.8}}],Line[{{7726,-12098.8},{7726,-10658.8}}],Line[{{7726,-12098.8},{7726,-10658.8}}],Line[{{8972,-9938.75},{7726,-10658.8}}],Line[{{8972,-11378.8},{8972,-9938.75}}],Line[{{5234,-9218.75},{5234,-7778.75}}],Line[{{5234,-7778.75},{6480,-8498.75}}],Line[{{6480,-9938.75},{6480,-8498.75}}],Line[{{6480,-8498.75},{5234,-9218.75}}],Line[{{5234,-10658.8},{5234,-9218.75}}],Line[{{5234,-10658.8},{5234,-9218.75}}],Line[{{5234,-9218.75},{6480,-9938.75}}],Line[{{8972,-9938.75},{7726,-9218.75}}],Line[{{7726,-9218.75},{7726,-10658.8}}],Line[{{7726,-10658.8},{8972,-9938.75}}],Line[{{8972,-8498.75},{8972,-9938.75}}],Line[{{7726,-9218.75},{8972,-8498.75}}],Line[{{8972,-9938.75},{7726,-9218.75}}],Line[{{7726,-9218.75},{6480,-9938.75}}],Line[{{6480,-9938.75},{7726,-10658.8}}],Line[{{7726,-10658.8},{6480,-9938.75}}],Line[{{6480,-11378.8},{7726,-10658.8}}],Line[{{5234,-10658.8},{6480,-11378.8}}],Line[{{6480,-11378.8},{5234,-12098.8}}],Line[{{5234,-12098.8},{5234,-10658.8}}],Line[{{6480,-9938.75},{5234,-10658.8}}],Line[{{6480,-11378.8},{6480,-9938.75}}],Line[{{5234,-10658.8},{6480,-11378.8}}],Line[{{11463,-9938.75},{12709,-10658.8}}],Line[{{12709,-10658.8},{12709,-9218.75}}],Line[{{12709,-9218.75},{11463,-9938.75}}],Line[{{11463,-9938.75},{12709,-10658.8}}],Line[{{11463,-8498.75},{12709,-9218.75}}],Line[{{11463,-9938.75},{11463,-8498.75}}],Line[{{11463,-9938.75},{11463,-8498.75}}],Line[{{12709,-7778.75},{11463,-8498.75}}],Line[{{12709,-9218.75},{12709,-7778.75}}],Line[{{8972,-7057.75},{8972,-5617.75}}],Line[{{8972,-5617.75},{10218,-6337.75}}],Line[{{10218,-7778.75},{10218,-6337.75}}],Line[{{10218,-6337.75},{8972,-7057.75}}],Line[{{8972,-8498.75},{8972,-7057.75}}],Line[{{8972,-8498.75},{8972,-7057.75}}],Line[{{8972,-7057.75},{10218,-7778.75}}],Line[{{12709,-7778.75},{11463,-7057.75}}],Line[{{11463,-7057.75},{11463,-8498.75}}],Line[{{11463,-8498.75},{12709,-7778.75}}],Line[{{12709,-6337.75},{12709,-7778.75}}],Line[{{11463,-7057.75},{12709,-6337.75}}],Line[{{12709,-7778.75},{11463,-7057.75}}],Line[{{11463,-7057.75},{10218,-7778.75}}],Line[{{10218,-7778.75},{11463,-8498.75}}],Line[{{11463,-8498.75},{10218,-7778.75}}],Line[{{10218,-9218.75},{11463,-8498.75}}],Line[{{8972,-8498.75},{10218,-9218.75}}],Line[{{10218,-9218.75},{8972,-9938.75}}],Line[{{8972,-9938.75},{8972,-8498.75}}],Line[{{10218,-7778.75},{8972,-8498.75}}],Line[{{10218,-9218.75},{10218,-7778.75}}],Line[{{8972,-8498.75},{10218,-9218.75}}],Line[{{12709,-6337.75},{13955,-7057.75}}],Line[{{13955,-7057.75},{13955,-5617.75}}],Line[{{13955,-5617.75},{12709,-6337.75}}],Line[{{12709,-7778.75},{12709,-6337.75}}],Line[{{13955,-7057.75},{12709,-7778.75}}],Line[{{12709,-6337.75},{13955,-7057.75}}],Line[{{13955,-7057.75},{15201,-6337.75}}],Line[{{15201,-6337.75},{13955,-5617.75}}],Line[{{13955,-5617.75},{15201,-6337.75}}],Line[{{15201,-4897.75},{13955,-5617.75}}],Line[{{16447,-5617.75},{15201,-4897.75}}],Line[{{15201,-4897.75},{16447,-4177.75}}],Line[{{16447,-4177.75},{16447,-5617.75}}],Line[{{15201,-6337.75},{16447,-5617.75}}],Line[{{15201,-4897.75},{15201,-6337.75}}],Line[{{16447,-5617.75},{15201,-4897.75}}],Line[{{12709,-4897.75},{13955,-5617.75}}],Line[{{12709,-6337.75},{12709,-4897.75}}],Line[{{12709,-6337.75},{12709,-4897.75}}],Line[{{13955,-4177.75},{12709,-4897.75}}],Line[{{13955,-5617.75},{13955,-4177.75}}],Line[{{12709,-3457.75},{13955,-4177.75}}],Line[{{12709,-4897.75},{12709,-3457.75}}],Line[{{16447,-7057.75},{16447,-5617.75}}],Line[{{16447,-5617.75},{15201,-6337.75}}],Line[{{15201,-7778.75},{15201,-6337.75}}],Line[{{15201,-7778.75},{15201,-6337.75}}],Line[{{15201,-6337.75},{16447,-7057.75}}],Line[{{15201,-7778.75},{16447,-8498.75}}],Line[{{16447,-7057.75},{15201,-7778.75}}],Line[{{16447,-8498.75},{16447,-7057.75}}],Line[{{15201,-7778.75},{16447,-8498.75}}],Line[{{12709,-6337.75},{12709,-7778.75}}],Line[{{16447,-4177.75},{16447,-5617.75}}],Line[{{18938,-5617.75},{20184,-6337.75}}],Line[{{20184,-6337.75},{20184,-4897.75}}],Line[{{20184,-4897.75},{18938,-5617.75}}],Line[{{18938,-5617.75},{20184,-6337.75}}],Line[{{18938,-4177.75},{20184,-4897.75}}],Line[{{18938,-5617.75},{18938,-4177.75}}],Line[{{18938,-5617.75},{18938,-4177.75}}],Line[{{20184,-3457.75},{18938,-4177.75}}],Line[{{20184,-4897.75},{20184,-3457.75}}],Line[{{16447,-2737.75},{16447,-1297.75}}],Line[{{16447,-1297.75},{17692,-2017.75}}],Line[{{17692,-3457.75},{17692,-2017.75}}],Line[{{17692,-2017.75},{16447,-2737.75}}],Line[{{16447,-4177.75},{16447,-2737.75}}],Line[{{16447,-4177.75},{16447,-2737.75}}],Line[{{16447,-2737.75},{17692,-3457.75}}],Line[{{20184,-3457.75},{18938,-2737.75}}],Line[{{18938,-2737.75},{18938,-4177.75}}],Line[{{18938,-4177.75},{20184,-3457.75}}],Line[{{20184,-2017.75},{20184,-3457.75}}],Line[{{18938,-2737.75},{20184,-2017.75}}],Line[{{20184,-3457.75},{18938,-2737.75}}],Line[{{18938,-2737.75},{17692,-3457.75}}],Line[{{17692,-3457.75},{18938,-4177.75}}],Line[{{18938,-4177.75},{17692,-3457.75}}],Line[{{17692,-4897.75},{18938,-4177.75}}],Line[{{16447,-4177.75},{17692,-4897.75}}],Line[{{17692,-4897.75},{16447,-5617.75}}],Line[{{16447,-5617.75},{16447,-4177.75}}],Line[{{17692,-3457.75},{16447,-4177.75}}],Line[{{17692,-4897.75},{17692,-3457.75}}],Line[{{16447,-4177.75},{17692,-4897.75}}]}],AspectRatio->Automatic]

g=RemoveMultipleEdges[LinesToGraph[l,100]]

ShowLabeledGraph[g,AspectRatio->Automatic,VertexStyle->Disk[.015]]

round[{x_,y_},s_:.144]:={Sqrt[3]/2Round[x/s 2/Sqrt[3]],1/2Round[2y/s]}

newv=round/@((#-{Vertices[g1][[1,1]],Vertices[g][[11,2]]})&/@Vertices[g]);

g1=ChangeVertices[g,newv];

Union[Norm/@Subtract@@@(Edges[g1]/.Thread[Range[V[g1]]->Vertices[g1]])]

Select[Union/@Flatten/@Subsets[Edges[g1],{3}],Length[#]==3&]

Vertices[g1]

Exact Construction

<<Utilities`Simplify`

Cumulate[Polyhedron[Icosahedron],Sqrt[6]/3]

Timing[poly=Map[Simplify[RootReduce[#]]&,Flatten[Cumulate[Polyhedron[Icosahedron],Sqrt[6]/3]],{3}]]

(v=PolyhedronVertices[poly])//InputForm
First/@poly/.Thread[v->Range[Length[v]]]

Properties

Faces

PolyhedronFaces[Spiky]//Length

Volume

FullSimplify[PolyhedronSymmetricVolume[Spiky]]

PolyhedronData["Spikey","Volume"]

N[%]

(v=Volume[PolyhedronData["Spikey","Faces"]]);//Timing

v

Surface Area

FullSimplify[PolyhedronSymmetricSurfaceArea[Spiky]]

PolyhedronData["Spikey","SurfaceArea"]

N[%]

a=PolyhedronSurfaceArea[PolyhedronData["Spikey","Faces"]];

RootApproximant[a]

N[a-RootApproximant[a],10^4]

RootReduce/@PolyhedronSurfaceArea[PolyhedronData["Spikey","Faces"]]

Inertia Tensor

(i=InertiaTensor["Spikey"])//Timing

PolyhedronData["Spikey","InertiaTensor"]

Skeleton

RecognizeGraph[CombinatoricaGraph["MathematicaSpiky"]]

GraphData["TriakisIcosahedralGraph","EdgeRules"]

PolyhedronData["MathematicaSpiky","SkeletonRules"]

i=Isomorphism[CombinatoricaGraph["MathematicaSpiky"],CombinatoricaGraph["TriakisIcosahedralGraph"]]

GraphData["TriakisIcosahedralGraph","VertexCoordinates"][[i]]

ShowGraph[CombinatoricaGraph["MathematicaSpiky"],ImageSize->150,AspectRatio->Automatic];

PolyhedronDataString

PolyhedronDataString[{Polyhedron[Spiky],"DuerersSolid","Dürer's solid"},{"Convex","Rigid"},Simplify]

Show[Normal[PolyhedronData["Spiky","SkeletonImage"]]/.Annotation[x_,y__]:>x/.Tooltip[x_,y__]:>Sequence@@{}];

Vertex Subset Hulls

p="MathematicaPolyhedron";

PolyhedronData[p]

Icosahedron

s=SymbolicUnion[Norm/@(v=PolyhedronData[p,"VertexCoordinates"])]//FullSimplify

i=Position[v,_?(Norm[#]==N[s[[1]]]&),1]//Flatten

Graphics3D[ConvexHull3D[v[[i]]],Boxed->False]

Platonic

(h=VertexSubsetHulls[p,"Platonic"])//Timing

h2=Insert[h,"Icosahedron"->{i},-2]

g=Function[poly,Graphics3D[{
{Gray,Opacity[.2],EdgeForm[],PolyhedronData[p,"Faces"]},ConvexHull3D[N[PolyhedronData[p,"VertexCoordinates"]][[#]]]&/@poly},Boxed->False]]/@h2[[All,2]]

GraphicsGrid[Partition[g,3,3,{1,1},{}],Spacings->-100]