# How should I reproduce this colorful swirling gif?

Surfing on the web, I came upon this cool gif:

Does any one know how to reproduce this in Mathematica? I have some ideas myself, so I will try to answer this question as well.

-
I saw it yesterday, I should have made it, ah :P – Kuba May 10 '14 at 15:34
I never messed around with Mathematica's sound functions. It would be cool to see an answer which produces the sounds as well! – Ali May 10 '14 at 20:31
@RahulNarain done :) – Kuba May 11 '14 at 13:45

### Embedded cdf with music version.code at the bottom

For full period, change max t to 200, my gif is cut in half because for some reasons I couldn't upload whole.

f[r_, t_] := Mod[-t (1 - r), 2. Pi];

dr = Pi /100.

Animate[Graphics[{
Table[{
AbsolutePointSize[10 # + 2 + 2 Unitize@Clip[f[#, t] - 5.5, {0, 1}]],
Blend[{Blend["Rainbow", #], White}, Clip[f[#, t] - 5.28, {0, 1}]],
Point[# {Cos@f[#, t], Sin@f[#, t]}]} &@i,
{i, 1 - dr, 0, -dr}],
White, Line[{{0, 0}, {2, 0}}]},
PlotRange -> 1.1, Background -> Black, ImageSize -> 300],
{t, 0, 100}, AnimationRate -> 5]


### more processor consuming but working smoothly - version with music:

As Öskå has noticed, it may not work on Linux.

It is not perfectly optimized, I just wonted to do this now and I hope I will have some time and motivation to improve it one day.

DynamicModule[{t, f, dt, dr, sound, graf},
Dynamic[Refresh[
Column[{
graf,
Animator[Dynamic[t, (t = #; With[{sel = Select[sound, t - dt <= #[[1]] <= t &]},
If[Length[sel] != 0, EmitSound@Sound[SoundNote@sel[[1, 2]]]]]) &],
{0, 200, dt}, AnimationRunning->False, AnimationRate->4, DisplayAllSteps->True]
}],

None]],
Initialization :> (
dt = .2;
f[r_, t_] := Mod[-t (1 - r), 2 Pi];
t = 0;

dr = Pi /100;

graf = Graphics[{
Dynamic@Table[With[{fi = f[i, t]},
{
AbsolutePointSize[5 i + 2 + If[fi > 6., 3, 0]],
Blend[{Blend["Rainbow", i], White}, Clip[fi - 5.5, {0, 1}]],
Point[i {Cos@fi, Sin@fi}]}],
{i, 1 - dr, 0, -dr}],
White, Line[{{0, 0}, {2, 0}}]},
PlotRange -> 1.1, Background -> Black, ImageSize -> 300];

sound = Composition[

SortBy[#, First] &,
{#[[1, 2]], #[[;; , 1]]} & /@ # &,
GatherBy[#, #[[2]] &] &,
Flatten[#, 1] &

]@Table[
Thread[{(-i + 1)/dr, Range[0, 200, #] &@(2 Pi/(1 - i))}], {i,
1 - dr, 0, -dr}];
)
]


-
So you did this at the end ). +1. – Leonid Shifrin May 10 '14 at 16:13
How'd you find the correct expression for the spiral? (Is there a standard expression? I don't know much about spirals...) – C. E. May 10 '14 at 16:18
@Pickett The only assumption I've made was to make it linear with r since there are rational relations between periods which result with nice configurations like cross or stars. – Kuba May 10 '14 at 16:19
And if this won't become a hot network question then I would be quite surprised :D – Yves Klett May 10 '14 at 19:26
Nice! Interesting music too. Stockhausen would be proud of you. – Sjoerd C. de Vries May 11 '14 at 19:23

Well this is my try, I could work a little bit on the color yet, but I'm pretty happy with it right-now:

Animate[
Show[
Graphics[
Transpose[{
Table[RGBColor[Sqrt[1-r^2], r Sin[θ],r Cos[θ]], {r,0.01,1,0.02}],
Table[Disk[{r Cos[-2(1-r)θ], r Sin[-2(1-r)θ]},r/60], {r,0.01,1,0.02}]}],
Background->Black],
PlotRange->{{-1,1},{-1,1}}, ImageSize->1000],
{θ,0,100π,π/40},DefaultDuration->180]


-
@Kuba Thanks for the edit. Do you know how to export gif animations from Mathematica? I could only do it with *.swf format. – Ali May 10 '14 at 16:12