Step Forward

This branched off of some work I did with my friend Elizabeth Denne at the ICERM Workshop on Illustrating Mathematics. In order to demonstrate the volume-by-slices idea in calculus, she and a student had previously made a 3D printed piece showing a 10-slice approximation to a solid with a circular base and triangular cross-section.

At the workshop we worked together to figure out how to animate the slices sliding into place in Mathematica; this is just a variation on that idea.

Code:

DynamicModule[{cols, tri},
 cols = Append[ColorData[3][#] & /@ Join[Range[2, 6], Range[8, 9]], 
   RGBColor["#E8F1F5"]];
 tri[x_, t_] := {{x, Sqrt[25 - x^2], 
    20 Haversine[Clip[t - 2 ? x/3, {0, ?}]]}, {x, -Sqrt[
      25 - x^2], 20 Haversine[Clip[t - 2 ? x/3, {0, ?}]]}, {x,
     0, Sqrt[25 - x^2]*Sqrt[3] + 
     20 Haversine[Clip[t - 2 ? x/3, {0, ?}]]}};
 Manipulate[
  Graphics3D[{Opacity[.3], 
    EdgeForm[Directive[Thickness[.002], GrayLevel[.4]]], 
    Table[{cols[[x + 4]],
      Prism[
       Flatten[{{15 s + 1/2, 0, 20 z} + # & /@ 
          tri[3 x/2, t], {15 s - 1/2, 0, 20 z} + # & /@ 
          tri[3 x/2, t]}, 1]]}, {z, -2, 1}, {s, -1, 1}, {x, -3, 3, 
      1}]}, PlotRange -> {{-30, 30}, {-6, 6}, {-45, 53}}, 
   ViewAngle -> ?/6.5, ViewPoint -> {0, -1, 0}, Boxed -> False, 
   ImageSize -> {540, 700}, Lighting -> "Neutral", 
   Background -> cols[[-1]]], {t, -3 ?, 4 ?}]
 ]