The animations are done using dynamic displays with off-screen controls. The programming is off-screen to avoid the potential distraction from the topic of the video, and avoid cluttering up the screen with a bunch of code that has nothing to do with statistics.
For a simple example of the basic idea, evaluate:
x = 0; Slider[Dynamic[x], {0, 10}]
to get a slider for controlling the global value of x (which is initially set to zero) and then evaluate
Dynamic[AngularGauge[x, {0, 10}]]
to get an angular gauge that shows the value of x. Moving the position of the slider changes the angular gauge.
The animation in the video is done by putting the slider in an off-screen notebook, and copying the dynamic AngularGauge display to the notebook shown in the video. The off-screen slider then controls the dynamic display in the video.
Other than that, the only difference in that particular animation is that there are two off-screen controls (one for use when describing “skewness” and one for use when describing “outliers”) and the display is a labeled NumberLinePlot graphic rather than an AngularGauge display.
There are several other animated illustrations in the statistics course that are done in this same way.
A disclaimer regarding the code for this animation is that this code is ad hoc and not intended for public release. This code is also not intended to show exemplary programming practice. It’s single-use code written to get the desired animation in this one example. There are lots of details here for getting the display to be exactly what is wanted. None of those details are especially tricky or complex, but there are nevertheless lots of details.
With that disclaimer, here is the code that was used to generate the animation in this video.
x = 0; Slider[Dynamic[x], {-4.3, 3.3}]
y = 0; Slider[Dynamic[y], {-30, 26}]
data = {45.4, 48.1, 49.7, 50.4, 51.5, 52.5, 53.4, 54.3, 54.8, 55.9,
57.8, 60.9}; Dynamic[
md = Median[data];
d1 = Take[data, 5] - md;
d2 = Take[data, -5] - md;
pts = If[x > 0, Join[md + d1, data[[{6, 7}]], md + (1 + x) d2],
Join[md + (1 - x) d1, data[[{6, 7}]], md + d2]] + {UnitStep[-y] y,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, UnitStep[y] y};
m = Mean[pts];
md = Median[pts];
Show[NumberLinePlot[pts, BaseStyle -> 14, ImageSize -> 600,
Epilog -> {Text[
StringTemplate["mean = ``"][Round[m, 0.001]], {m, 4.8}],
Arrow[{{m, 2}, {m, 1.5}}],
Text[StringTemplate["median = ``"][md], {md, -3.2}],
Arrow[{{md, -1}, {md, 0}}]}, AspectRatio -> 0.2,
PlotStyle -> PointSize[0.01]],
Graphics[{Opacity[0], Point[{45, 5}], Point[{45, -5}]}],
PlotRange -> {{20, 80}, Automatic}]]
