# [GIF] Cantellation (Cross sections of the 16-cell)

Posted 3 years ago
4086 Views
|
7 Replies
|
10 Total Likes
|
 CantellationAnother GIF given by taking cross sections of some convex shape (previously here and here). This time, we're looking at cross sections of the 16-cell, so the cross sections are 3-dimensional polyhedra. In fact, this turns out to be a nice illustration of the fact that the cuboctahedron is the cantellated tetrahedron and, moreover, that if you continue the cantellation as far as it can go, you end up with the tetrahedron dual to the one you started with. As usual, I'm using my general slicing function: slices[edges_, vec_, plotrange_] := Module[{projector, pedges, n, times, positions, v}, projector = Orthogonalize[NullSpace[{vec}]]; pedges[t_] := (1 - t) #[[1]] + t #[[2]] & /@ edges; n = Length[pedges[.5]]; times = Table[NSolve[{pedges[t][[i]].vec == #, 0 <= t <= 1}, t], {i, 1, n}]; positions = Flatten[Position[times, a_ /; a != {}, 1]]; v = Table[ pedges[t][[positions[[i]]]] /. Flatten[times[[positions[[i]]]], 1], {i, 1, Length[positions]}]; ConvexHullMesh[projector.# & /@ v, PlotRange -> plotrange, PlotTheme -> "Polygons"] ] & I also need the vertices and edges of the 16-cell: sixteencellvertices = Normalize /@ Flatten[Permutations[{-1, 0, 0, 0}]^# & /@ Range[1, 2], 1]; sixteencelledges = Select[Subsets[sixteencellvertices, {2}], #[[1]] != -#[[2]] &]; And then, finally, here's the Manipulate (notice that it struggles for values of s near $0$ and $\pi$, I believe because the BoundaryMesh consists of a huge number of simplices for these values of s): DynamicModule[{cols}, cols = Append[RGBColor /@ {"#88BEF5", "#F469A9"}, GrayLevel[.2]]; Manipulate[ Graphics3D[{EdgeForm[None], Blend[{cols[[1]], cols[[2]]}, 1/2 - 1/2 Cos[s]], GraphicsComplex[MeshCoordinates[#], MeshCells[#, 2]] &[ TriangulateMesh[ slices[sixteencelledges, Normalize[{1, 1, 1, 1}], 1][ 1/2 Cos[s]], MaxCellMeasure -> 100]]}, PlotRange -> 1, ImageSize -> 540, Boxed -> False, ViewPoint -> 10 {0, 0, 1}, ViewVertical -> {0, -1, 0}, ViewAngle -> π/30, Lighting -> "Neutral", Background -> cols[[3]]], {s, 0, π}] ] 
7 Replies
Sort By:
Posted 3 years ago
 @Moderation Team Very cool.
Posted 3 years ago
 We posted this from the official Wolfram Twitter and Facebook. Thank you!
Posted 3 years ago
 Not sure, but maybe @Ed Pegg knows.
Posted 3 years ago
 @Moderation Team Thanks!
Posted 3 years ago
 @Sam Carrettie Good point. In fact, skeletons of five of the six regular convex 4-polytopes are given in the RegularPolychoron class of GraphData. Strangely, when you run GraphData["RegularPolychoron"] the output is {"HundredTwentyCellGraph", "SixHundredCellGraph", "SixteenCellGraph", "TesseractGraph", "TwentyFourCellGraph"} meaning that PentatopeGraph (which is a valid named graph and is indeed the skeleton of the 5-cell) isn't in the RegularPolychoron class. Does anybody know why?
 This is very nice, thanks. There is a good MathWorld article with some references to built in data about 16-cell. For example. The vertices of the 16-cell with circumradius 1 and edge length $\sqrt2$ are the permutations of $(\pm1, 0, 0, 0)$. There are 2 distinct nonzero distances between vertices of the 16-cell in 4-space. The skeleton of the 16-cell is implemented in the Wolfram Language as GraphData["SixteenCellGraph"]. When embedded in three-space, the 16-cell skeleton is a cube with an "X" connecting diagonally opposite vertices on each face. GraphData["SixteenCellGraph", "Graphs"]  GraphData["SixteenCellGraph", "Graphs3D"]