# [GIF] Hidden Depths (Reflections in a Disk)

Posted 2 years ago
3279 Views
|
2 Replies
|
6 Total Likes
|
 Hidden DepthsThis is a follow-up to Emergent Order; in both, rays extend from a common starting point, reflecting off the boundary of the disk whenever they meet it. The only differences are the colors and the starting points. In general, of course, one can cause any regular polygon to be repeatedly covered by choosing an appropriate starting point.The code uses NDSolve along with WhenEvent to handle the reflections; as written it's not very efficient, but here's the code I used to generate the GIF: sol = With[ {ψ = π/10, n = 40}, Table[ NDSolve[{x'[t] == a[t], y'[t] == b[t], x[0] == 0, y[0] == Sin[ψ], a[0] == Cos[θ], b[0] == Sin[θ], WhenEvent[ x[t]^2 + y[t]^2 == 1, {a[t], b[t]} -> -(2*({a[t], b[t]}.{-x[t], -y[t]}) {-x[t], -y[t]} - {a[t], b[t]})] }, {x, y}, {t, 0, 100}, DiscreteVariables -> {a, b}], {θ, 0, 2 π - 2 π/n, 2 π/n}]]; star = With[ {cols = RGBColor /@ {"#F5E495", "#F7825D", "#00032D"}}, ParallelTable[ Show[ ParametricPlot[{x[t], y[t]} /. sol, {t, 0, If[s <= 1, s^2, s^(3/2)]}, Frame -> True, FrameTicks -> None, PlotRange -> 1.2, Background -> cols[[-1]], ImageSize -> {540, 540}, Axes -> False, PlotStyle -> Directive[Thickness[.0005], cols[[1]]]], Graphics[{Darker[cols[[2]], .45], Thickness[.004], Circle[]}]], {s, .0001, 8.0001, .08}] ]; Export[NotebookDirectory[] <> "star.gif", star, "DisplayDurations" -> Append[Prepend[ConstantArray[1/12, 99], 1], 3]] 
2 Replies
Sort By:
Posted 2 years ago
 - another post of yours has been selected for the Staff Picks group, congratulations !We are happy to see you at the top of the "Featured Contributor" board. Thank you for your wonderful contributions, and please keep them coming!