Одна линия, чтобы рассказать историю или Bad Apple на графике WL

Сначала получаем видеофайл анимации Bad Apple каким-либо образом и загружаем его в любую ячейку ввода. Извлечем один кадр

video = Import[FileNameJoin[{"attachments", "Touhou - Bad Apple.mp4"}], 
{"ImageList", All}];
img = video[[500]] // Thumbnail

Кстати, удобно, что Bad Apple выполнена в стиле теневой анимации, поэтому мы можем легко преобразовать любое изображение в сетку из 1 и 0. Если знать положение каждого темного пикселя, то не составит труда обойти их всех одной линией

img = img // ImageAdjust // Binarize;
pos = PixelValuePositions[img, 0];
{length, path} = FindShortestTour[pos];

Здесь нам не нужна длина, а только сам путь, который содержит индексы точек из pos, соединённых в нужном порядке для формирования кратчайшего маршрута через все тёмные пиксели

ListLinePlot[pos[[path]]]

Чтобы убрать угловатости, можно сгладить скользящим средним

ListLinePlot[MovingAverage[pos[[path]], 5]]

Если повторить это со всеми кадрами и стащить звук отдельный байт массив, то можно сделать такую анимацию в реальном времени.

Код полной анимации приведен в этой статье (EN).