Toss
Inspired by Example 5 from the Wikipedia article on "Envelope (mathematics)". Basically: if you throw a projectile from the origin with initial speed $v$ and initial angle $\theta$ subject to gravitational acceleration $g$, then its trajectory as a function of $t$ is given by:
Trajectory[t_, v_, g_, ?_] := {t v Cos[?], t v Sin[?] - g/2 t^2};
All such trajectories are tangent to the parabola $y=\frac{v^2}{2g}-\frac{g}{2v}x^2$, so the parabola is the envelope of the family of trajectories.
The animation shows a number of trajectories simultaneously, and the resulting envelope emerges without ever being explicitly drawn.
Note that the animation is not to scale: I've used AspectRatio -> 1
to scale the vertical axis to get proportions that work better for a square image. A more physically realistic animation is:
The code is below, but I want to point out a couple of quirks. I originally used ParametricPlot
rather than Graphics
, which is conceptually simpler, but there seems to be a bug in the interaction of CapForm
and ParametricPlot
which makes it basically impossible to get endcaps to look right.
Consequently, I re-implemented the trajectories as a table of Line
s, which mostly works okay, except that you can't really use transparency with concatenated lines unless you use CapForm["Butt"]
or CapForm[None]
: for example, with CapForm["Round"]
the lines overlap, creating spots of increased opacity. This can make for a cool visual effect, but doesn't lend itself to a nice smooth gradient. Unfortunately, using CapForm["Butt"]
leaves tiny gaps between the adjacent line segments, which I obscured by exporting the original GIF at 2160x2160 and then resizing down to 540x540.
Anyway, hopefully that explains most of the oddities in the code, which is not exactly speedy:
DynamicModule[{v = 1., g = 10., n = 101, timesteps = 75, transparencypoint = 3/2, pts,
cols = RGBColor /@ {"#393C83", "#C84771", "#FFE98A", "#280B45"}},
pts = Join[
Table[Trajectory[t, v, g, ?], {?, 0., ?/2, ?/n}, {t, 0., 2 v/g, 2 v/(timesteps*g)}],
Table[Trajectory[t, v, g, ?], {?, ? + 0., ?/2, -?/n}, {t, 0., 2 v/g, 2 v/(timesteps*g)}]];
Manipulate[
Graphics[
{Thickness[.004],
Table[{
If[i == s, CapForm["Round"], CapForm["Butt"]],
Opacity[Min[1, transparencypoint + 2 (i - s)/timesteps]],
Blend[cols[[;; -2]], (i - 1)/(Length[pts[[1]]] - 1)],
Line[pts[[j, i ;; i + 1]]]},
{j, 1, Length[pts]}, {i, 1, Min[s, timesteps]}]},
ImageSize -> 540, PlotRange -> {6/5 {-v^2/g, v^2/g}, {0, 5/4 v^2/(2 g)}},
AspectRatio -> 1, Axes -> False, Background -> cols[[-1]]],
{s, 0, timesteps (1 + transparencypoint/2), 1}]
]