Message Boards Message Boards

[GIF] Hidden Depths (Reflections in a Disk)


Reflections in a Disk

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[
   {ψ = π/10, n = 40},
    NDSolve[{x'[t] == a[t], y'[t] == b[t], x[0] == 0, 
      y[0] == Sin[ψ], a[0] == Cos[θ], 
      b[0] == Sin[θ],
       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"}},
     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]]
POSTED BY: Clayton Shonkwiler
1 year ago

enter image description here - 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!

POSTED BY: Moderation Team
1 year ago

Really beauty! <3

POSTED BY: Manoel Vilela
1 year ago

Group Abstract Group Abstract