Facile à Retenir

A colleague of mine recently 3D-printed the tessellation of 3-space by permutohedra, so I started playing around with the permutohedron a bit. As I am wont to do, I ended up stereographically projecting the vertices to the plane, and then tried rotating. The final GIF isn't really anything in particular: it's basically a random assortment of techniques. I picked three particular rotations around the $x$-axis which produced nice stereographic images, connected the projected vertices by straight lines, and then did a very simple interpolation between the three configurations.

Here's the code:

First, define stereographic projection:

Stereo[{x_, y_, z_}] := {x/(1 - z), y/(1 - z)};

Then a general function for producing the edges of the permutohedron of order n, which naturally sits in the hyperplane in $\mathbb{R}^n$ given by $x_1 + \ldots + x_n = \frac{n(n+1)}{2}$:

permutohedronEdges[n_] := 
  Select[Subsets[Permutations[Range[n]], {2}], 
   Or @@ Table[
      Position[#[[1]], i] == Position[#[[2]], i + 1] && 
       Position[#[[1]], i + 1] == Position[#[[2]], i] && 
       And @@ Table[
         Position[#[[1]], Mod[i + j, n, 1]] == 
          Position[#[[2]], Mod[i + j, n, 1]], {j, 2, n - 1}], {i, 1, 
       n - 1}] &];

And now, since the permutohedron sits in a hyperplane, here's the matrix for projecting out the perpendicular direction:

permutohedronProjectionMatrix[n_] := 
  Orthogonalize[NullSpace[Transpose[#].#]] &[{ConstantArray[1, n]}];

With $n=4$, I end up with the (vertices of the) truncated octahedron sitting in $\mathbb{R}^3$, which I'm going to stereographically project down to the plane. When rotating around the $x$-axis, these angles give particularly symmetric images:

landmarks = N[{0, 38 \[Pi]/125, 76 \[Pi]/125, \[Pi]}];

And, finally, here's the Manipulate that puts the whole thing together:

Manipulate[
 Module[{s, cols},
  s = 1/2 - Cos[\[Pi] Mod[t, 1]]/2;
  cols = RGBColor /@ {"#b9d8de", "#f0a471", "#fae49e", "#1c818c"};
  Graphics[{Blend[{cols[[Mod[Floor[t + 1], 3, 1]]], 
      cols[[Mod[Ceiling[t + 1], 3, 1]]]}, Mod[t, 1]], Thickness[.01], 
    CapForm["Round"], (Line /@ (((1 - s) # /. {\[Theta] -> 
              landmarks[[Floor[t + 1]]]}) + (s  # /. {\[Theta] -> 
              landmarks[[Ceiling[t + 1]]]}))) &[
     Stereo[
          RotationMatrix[\[Theta], {1, 0, 0}].Normalize[
            permutohedronProjectionMatrix[4].#]] & /@ # & /@ 
      permutohedronEdges[4]]}, PlotRange -> 5, ImageSize -> 540, 
   Background -> cols[[-1]]]], {t, 0, 3}]