Give Me Some Space
No fancy math in this one.
If you rectify the tetrahedron (meaning cut off each corner with a plane passing through the midpoint of each incident edge) you get the octahedron, and the corners you cut off are smaller tetrahedra. This GIF just illustrates the decomposition of the tetrahedron into the octahedron and the four smaller tetrahedra with some movement and color to emphasize what’s going on.
Code:
smootheststep[t_] := -20 t^7 + 70 t^6 - 84 t^5 + 35 t^4;
DynamicModule[{hedron = "Tetrahedron", v, e, n, ov, oe, s, r, cols},
v = PolyhedronData[hedron, "VertexCoordinates"];
e = PolyhedronData[hedron, "Edges"][[2]];
n = Length[v];
ov = RotationTransform[?/12, {0, 0, 1}] /@
PolyhedronData["Octahedron", "VertexCoordinates"];
oe = PolyhedronData["Octahedron", "Edges"][[2]];
cols = RGBColor /@ {"#FEFFFE", "#FF6663", "#E0FF4F", "#0B3954"};
Manipulate[
s = smootheststep[t];
r = smootheststep[1 - Abs[1 - 2 t]];
Graphics3D[
{Thickness[.004],
Blend[cols[[1 ;; 2]], r],
Table[{GraphicsComplex[(1/2 + r/2) v[[i]] + RotationTransform[2 ?/3 s, v[[i]]][#] & /@ (v/2), e]},
{i, 1, Length[v]}],
Blend[cols[[{1, 3}]], r],
GraphicsComplex[
RotationTransform[ArcCos[4/7] + ? s,
Cross[{Cos[?/3], Sin[?/3], 0}, {0, 0, 1}]][1/2 ov], oe]},
Boxed -> False, ImageSize -> {540, 540}, PlotRange -> 2.5,
ViewPoint -> 10 {Cos[2 ?/3], Sin[2 ?/3 ], 0.712},
ViewAngle -> ?/120, ViewVertical -> {0, 0, 1},
SphericalRegion -> True, Lighting -> "Neutral",
Background -> cols[[-1]]],
{t, 0, 1}]
]
