Cantellation
Another 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, ?}]
]
