Message Boards Message Boards

4
|
9032 Views
|
4 Replies
|
5 Total Likes
View groups...
Share
Share this post:

[GIF] Omnitruncated (More permutohedra)

Omnitruncated 5-cells

Omnitruncated

Following up on my earlier permutohedron GIF, the key elements of this GIF are two projections of the permutohedron of order 5, which is a 4-dimensional polytope (in fact, it's the omnitruncated 5-cell...hence the title), which are being linearly interpolated between.

Here's a 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}$, together with the matrix for projecting out the perpendicular direction:

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}] &];
permutohedronProjectionMatrix[n_] := 
  Orthogonalize[NullSpace[Transpose[#].#]] &[{ConstantArray[1, n]}];

And the slightly gross Manipulate for the animation (the use of angles like $\pi/2 + .0001$ is a really inelegant way of avoiding zero-length edges, which gunk up the image with unwanted dots):

Manipulate[Module[{t, cols, rotproj1, rotproj2},
  t = 1/2 - (-1)^Floor[s] Cos[π s]/2 + Floor[s];
  cols = RGBColor /@ {"#D8FFF1", "#5B73A7"};
  rotproj1 = 
   RotationMatrix[π/2 - 
      ArcTan[Sqrt[3/5]]].({{Cos[θ], 0, 0, -Sin[θ]}, {0, 
        0, 1, 0}} /. θ -> π/
         2 + .0001).permutohedronProjectionMatrix[5];
  rotproj2 = ({{Cos[θ], 0, 0, -Sin[θ]}, {0, 1, 0, 
        0}} /. θ -> π/
         2 - .0001).permutohedronProjectionMatrix[5];
  Graphics[{Thickness[.01], cols[[1]], CapForm["Round"], 
    JoinForm["Round"], 
    Line /@ ((1 - Min[t, 1]) (rotproj1.# & /@ # & /@ 
          permutohedronEdges[5]) + (1 - 
          Abs[t - 1]) (rotproj2.# & /@ # & /@ 
          permutohedronEdges[5]) + (Max[t, 1] - 
          1) ({#[[1]], -#[[2]]} & /@ # & /@ (rotproj1.# & /@ # & /@ 
            permutohedronEdges[5])))}, PlotRange -> 5, 
   ImageSize -> 540, Background -> cols[[2]]]], {s, 0, 2}]
4 Replies

enter image description here -- you have earned Featured Contributor Badge enter image description here

Your exceptional post has been selected for our editorial column Staff Picks http://wolfr.am/StaffPicks and Your Profile is now distinguished by a Featured Contributor Badge and is displayed on the Featured Contributor Board. Thank you!

POSTED BY: EDITORIAL BOARD

I think you meant to have Pi instead of ? on the second set of code.

Manipulate[
 Module[{t, cols, rotproj1, rotproj2}, 
  t = 1/2 - (-1)^Floor[s] Cos[Pi s]/2 + Floor[s]; 
  cols = RGBColor /@ {"#D8FFF1", "#5B73A7"};
  rotproj1 = 
   RotationMatrix[
     Pi/2 -  ArcTan[
       Sqrt[3/5]]].({{Cos[Pi], 0, 0, -Sin[Pi]}, {0,  0, 1, 0}} /. 
      Pi -> Pi/
         2 + .0001).permutohedronProjectionMatrix[5];
  rotproj2 = ({{Cos[Pi], 0, 0, -Sin[Pi]}, {0, 1, 0,  0}} /. Pi -> Pi/
         2 - .0001).permutohedronProjectionMatrix[5];
  Graphics[{Thickness[.01], cols[[1]], CapForm["Round"], 
    JoinForm["Round"], 
    Line /@ ((1 - Min[t, 1]) (rotproj1.# & /@ # & /@ 
          permutohedronEdges[5]) + (1 - 
          Abs[t - 1]) (rotproj2.# & /@ # & /@ 
          permutohedronEdges[5]) + (Max[t, 1] - 
          1) ({#[[1]], -#[[2]]} & /@ # & /@ (rotproj1.# & /@ # & /@ 
            permutohedronEdges[5])))}, PlotRange -> 5, 
   ImageSize -> 540, Background -> cols[[2]]]], {s, 0, 2}]

But other than that, pretty cool!

POSTED BY: Santiago Camacho

Some were Pi and some were \[Theta]. This is a Wolfram Community bug that seems to occasionally replace special characters with question marks. I think I just fixed it, but let me know if there are still problems.

That works pretty well, thanks!

POSTED BY: Santiago Camacho
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