Waves from Circles with Mathematica
A recent Google+ post from Mathemania4u caught my attention on the train to work this morning. I just had to code up something that looked like this and so fired up Mathematica and hacked away. The resulting notebook can be downloaded here. It’s not particularly well thought through so could almost certainly be improved on in many ways.
The end result was a Manipulate which you’ll be able to play with below, provided you have a compatible Operating System and Web browser. The code for the Manipulate is
Manipulate[ Graphics[Map[dotCirc, circArray[circrad, theta, pointsize, extent, step, phase, showcirc]]] , {{showcirc, True, "Show Circles"}, {True, False}} , {{theta, 0, "Dot Angle"}, 0, 2 Pi, Pi/10, Appearance -> "Labeled"} , {{pointsize, 0.018, "Dot Size"}, 0, 1, Appearance -> "Labeled"} , {{phase, 2, "Phase Diff"}, 0, 2 Pi, Appearance -> "Labeled"} , {{step, 0.25, "Circle Separation"}, 0, 1, Appearance -> "Labeled"} , {{extent, 2, "Plot Extent"}, 1, 5, Appearance -> "Labeled"} , {{circrad, 0.15, "Circle Radius"}, 0.01, 1, Appearance -> "Labeled"} , Initialization :> { dotCirc[{x_, y_, r_, theta_, pointsize_, showcirc_}] := If[showcirc, {Circle[{x, y}, r], PointSize[pointsize], Point[{x + r Cos[theta], y + r Sin[theta]}]} , {PointSize[pointsize], Point[{x + r Cos[theta], y + r Sin[theta]}]}] , circArray[r_, theta_, pointsize_, extent_, step_, phase_, showcirc_] := Module[{}, Partition[ Flatten[Table[{x, y, r, theta + x*phase + y*phase, pointsize, showcirc}, {x, -extent, extent, step}, {y, -extent, extent, step}]], 6] ]}]
If you can use the Manipulate below, I suggest clicking on the + icon to the right of the ‘Dot Angle’ field to expose the player controls and then press the play button to kick off the animation.
I also produced a video – The code used to produce this is in the notebook.
)
Nice. Here is a EMT version. Looks cleaner. But cannot be “manipulated”.
I made GIF here: http://observations.rene-grothmann.de/waving-dots/