How do I generate the Mathematica Version 2 Spikey in Mathematica?

Question

As we all know, Mathematica changes its logo design with every new version, while still maintaining the dodecahedral/icosahedral motif.

I have been able, through much digging around, to finally acquire the code for generating the logos corresponding to versions three, four, and five. I was able to obtain code for generating the version six logo from this blog post by Michael Trott (it is also available here).

However, I have not been so successful in finding code for the version two logo:

Some searching seems to indicate that there is code for this in one of the Mathematica Guidebooks by Trott, but the libraries I have access to do not have copies of these tomes. (Google Books will also not let me preview the pages where the code seems to be.)

I have also tried sending an e-mail to Michael Trott and Igor Rivin, but I have not gotten any response from them in three weeks, so it would seem that they are unable or unwilling to supply the code for generating the version two logo.

So, how might I generate the version 2 Mathematica spikey?

Answer 1

I don't know how he did it. There doesn't seem to be an equation in any of the papers. Based on the only equation for a hyperbolic polyhedron available ($x^{2/3}+y^{2/3}+z^{2/3}=1$ for the hyperbolic octahedron), I have attempted to reconstruct the transformation leading from Euclidean to hyperbolic polyhedra.

Construct a function that we know would take an octahedron to the given hyperbolic octahedron. The form is complicated, so compile it to save a lot of time.

rsol = r /. Solve[{(r a)^(2/3) + (r b)^(2/3) == 1}, r];
rconv = rsol /. 
  Thread[{a, b} -> {(1 + Sqrt[Abs[2 R^2 - 1]])/(2 R),
      (1 - Sqrt[Abs[2 R^2 - 1]])/(2 R)}]
rcomp = Compile[{{R, _Real}}, Evaluate[rconv[[2]]], 
  CompilationTarget -> "C", RuntimeOptions -> "Speed"]

This has singularities at a couple important points that we can remove.

rR[r_ /; Abs[r - 1] < 0.001] := 1.0;
rR[r_ /; Abs[r - 1/\[Sqrt]2] < 0.001] := 0.5
rR[r_?NumericQ] := rcomp[r]

Then we can use it to hyperbolicize:

hyperbolicize[cR_][p_] := 
 p /. Polygon[x_] :> Polygon[#/Norm[#] rR[Norm[#]/cR] & /@ N[x]]

The function depends on the circumradius, and we need to select a scheme for subdividing the faces of the basal dodecahedron. A couple iterations of facebreak and edgebreak does a nice job.

facebreak[p_] := 
 p /. Polygon[x_] :> (Polygon[Append[#, Mean[x]]] &) /@ 
    Partition[Append[x, First[x]], 2, 1]

edgebreak[p_] := 
 p /. Polygon[x_] :> 
   Polygon /@ (Append[
        Partition[RotateRight[Riffle[x, #]], 3, 2, 1], #] &[
      Mean /@ Partition[x, 2, 1, 1]])

Module[{poly = "Dodecahedron"}, 
 Graphics3D[{hyperbolicize[PolyhedronData[poly, "Circumradius"]]@
    Nest[edgebreak@facebreak@# &, 
     Normal@PolyhedronData[poly, "Faces"], 2]}, Boxed -> False]]

Answer 2

I never saw the OP's mail :( The answer is this: the polyhedron is the ideal polyhedron in the Poincare model of hyperbolic space (so the faces are spheres orthogonal to the unit sphere). To produce the picture, first generate the Platonic solid inscribed in the unit sphere. This can be thought of as the ideal polyhedron in the Beltrami-Klein model of hyperbolic space. The transformation of the Klein-Beltrami model into the Poincare model is described in this Wikipedia article, so just apply it (you need to subdivide the faces into triangles, and then apply the transformation to the vertices).