The code begins by seeding the random generator with and precomputing static parameters. holds radial distances, assigns a small random angular increment to each radius, computes each circle's display size, center fixes the common origin, and sets how many fading outlines to draw.
SeedRandom[5]
rList
deltaList
radiiList
trailLen
A wraps two persistent variables: , the index of the currently red circle, and , a list of indices temporarily excluded from color transfer. A animates a frame counter f from 0 to 10000 using an control running at 30 frames per second.
redIdx
inactiveSet
On every frame, a recalculates angular positions by multiplying f with , incorporating a fixed 9000-frame phase shift—. It converts the red circle's current angle into Cartesian coordinates and tests all other circles for overlap via . Any newly overlapping circle not in immediately becomes the new , and the previous is added to ; once no overlaps remain, is cleared to allow future transfers.
deltaList
angles = (f + 9000) * deltaList
inactiveSet
redIdx
redIdx
inactiveSet
inactiveSet
The code then builds two disk collections: one for all non-red circles (filled black) and one for the red circle (filled red), both edged in white. It also generates a fading trail of past outlines by drawing multiple primitives with decreasing opacity and constant angular offset, plus radial spokes using primitives.
Finally, all visual elements are combined in a single expression with a fixed plot range of -100 to 600 in both axes, a solid black background, and a defined , ensuring the animation remains stable and centered throughout.
In[]:=
SeedRandom[5];rList = Range[30, 300, 10];deltaList = RandomReal[{-0.5, 0.5}, Length[rList]]/60;radiiList = (30 + rList^2/10000)/2;center = {250, 250};trailLen = 33;DynamicModule[{redIdx = 1, inactiveSet = {}}, Manipulate[ Module[{angles, posRed, overlaps, available, newIdx, blackDisks, redDisk}, (* compute angles and red circle position *) angles = (f + 9000)*deltaList; posRed = center + rList[[redIdx]]*{Cos[angles[[redIdx]]], Sin[angles[[redIdx]]]}; (* find overlapping circles *) overlaps = Select[ Range[Length[rList]], # != redIdx && EuclideanDistance[ posRed, center + rList[[#]]*{Cos[angles[[#]]], Sin[angles[[#]]]} ] < radiiList[[redIdx]] + radiiList[[#]] & ]; (* transfer red only to new circles, never back while overlapping *) available = Complement[overlaps, inactiveSet]; If[available =!= {}, (* transfer to first new overlap *) newIdx = First[available]; inactiveSet = Append[inactiveSet, redIdx]; redIdx = newIdx, (* if no overlaps, reset for next event *) If[overlaps === {}, inactiveSet = {}] ]; (* build disk primitives *) blackDisks = MapThread[ Disk[ center + #1*{Cos[#2], Sin[#2]}, #3 ] &, {Delete[rList, redIdx], Delete[angles, redIdx], Delete[radiiList, redIdx]} ]; redDisk = Disk[ center + rList[[redIdx]]*{Cos[angles[[redIdx]]], Sin[angles[[redIdx]]]}, radiiList[[redIdx]] ]; (* render trails, spokes, and disks *) Graphics[ Join[ Table[ { Opacity[(trailLen - k)/trailLen], AbsoluteThickness[1], White, MapThread[ Circle[ center + #1*{Cos[#2 - k #3], Sin[#2 - k #3]}, #4 ] &, {rList, angles, deltaList, radiiList} ] }, {k, 1, trailLen}], { {AbsoluteThickness[3], White, MapThread[ Line[{center, center + #1*{Cos[#2], Sin[#2]}}] &, {rList, angles} ] }, {EdgeForm[{AbsoluteThickness[3], White}], FaceForm[Black], blackDisks}, {EdgeForm[{AbsoluteThickness[3], White}], FaceForm[Red], redDisk} } ], PlotRange -> {{-100, 600}, {-100, 600}}, Background -> Black, ImageSize -> 550 ] ], {f, 0, 10000, Animator, AnimationRate -> 30, AnimationRunning-> True} ]]
Out[]=
CITE THIS NOTEBOOK
CITE THIS NOTEBOOK
Red dot thorny journey through the realms of time: random walk shaped by overlap events
by Vitaliy Kaurov
Wolfram Community, STAFF PICKS, May 8, 2025
https://community.wolfram.com/groups/-/m/t/3457220
by Vitaliy Kaurov
Wolfram Community, STAFF PICKS, May 8, 2025
https://community.wolfram.com/groups/-/m/t/3457220