Hidden Depths
This 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[
{α = Pi/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 Pi - 2 Pi/n, 2 Pi/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]]
