Message Boards Message Boards

[GIF] Eyes Wide (Stereographic projection of spherical circle packing)

Stereographic projection of optimal circle packing of the sphere by five circles

Eyes Wide

Very much in the same spirit as Pack It In, this shows the stereographic image of the optimal packing of the sphere by five circles. The circles are centered at the (normalized) vertices of the triangular bipyramid.

The coloration is misleading, in that the five circles are partitioned into a group of three (the three centered on points $120^\circ$ apart on the equator) and a group of two (the two centered on the north and south poles), but the colors don't match up with those groupings. The two blue circles are two of the three circles centered on the equator; the third is the one circle that doesn't touch those two blue circles.

Anyway, here's the code:

Stereo[p_] := Most[p]/(1 - Last[p]);

DynamicModule[{p, b, t = ?/4.,
  verts = 
   RotationTransform[?/6, {0, 0, 1}][Normalize[N[#]]] & /@ PolyhedronData[{"Dipyramid", 3}, "VertexCoordinates"],
  cols = RGBColor /@ {"#B91372", "#41EAD4", "#011627"}},
 Manipulate[
  p = verts.RotationMatrix[-?, {1, 0, 0}];
  b = Orthogonalize[NullSpace[{#}]] & /@ p;
  Graphics[
   {FaceForm[None],
    Table[
     {EdgeForm[
       Directive[Thickness[.0075], cols[[Mod[Ceiling[i/3], 2, 1]]]]],
      Polygon[Table[Stereo[Cos[t] p[[i]] + Sin[t] (Cos[s] b[[i, 1]] + Sin[s] b[[i, 2]])], {s, 0, 2 ?, 2 ?/200}]]},
     {i, 1, Length[verts]}]},
   PlotRange -> 5, Background -> cols[[-1]], ImageSize -> 540],
  {?, 0, 2 ?}]
 ]
4 Replies

enter image description here - Congratulations! This post is now a Staff Pick as distinguished on your profile! Thank you, keep it coming!

POSTED BY: Moderation Team

Great! Not sure if anyone noticed, but this creates an optical illusion of the whole thing floating upwards. That's rare, because I think most of the optical illusions are static, right? - and this one is produced by the dynamic part.

POSTED BY: Vitaliy Kaurov

Huh, interesting!

I feel like there are some animations (even some of mine, probably) that are sort of visual versions of a Shepard tone.

Posted 7 years ago

Very neat! Only a few minor things:

  1. I would have computed verts like this:

    verts = Normalize /@ N[PolyhedronData[{"Dipyramid", 3}, "VertexCoordinates"]].RotationMatrix[-?/6, {0, 0, 1}]
    

(note the use of the inverse/transpose, since I'm post-multiplying instead of pre-multiplying)

  1. As I pointed out in one of your previous posts, if your are already using inexact numbers, NullSpace[] will automatically return orthonormalized vectors (via SVD), so b = NullSpace[{#}] & /@ p suffices.

Otherwise, nicely done. :)

POSTED BY: J. M.
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract