14
$\begingroup$

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

animation

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.

$\endgroup$
4
  • 3
    $\begingroup$ I saw it yesterday, I should have made it, ah :P $\endgroup$
    – Kuba
    May 10, 2014 at 15:34
  • 5
    $\begingroup$ This animation is supposed to have music along with it! $\endgroup$
    – user484
    May 10, 2014 at 20:09
  • $\begingroup$ I never messed around with Mathematica's sound functions. It would be cool to see an answer which produces the sounds as well! $\endgroup$
    – Ali
    May 10, 2014 at 20:31
  • 1
    $\begingroup$ @RahulNarain done :) $\endgroup$
    – Kuba
    May 11, 2014 at 13:45

2 Answers 2

29
$\begingroup$

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]

enter image description here


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}];
   )
 ]

$\endgroup$
6
  • $\begingroup$ So you did this at the end ). +1. $\endgroup$ May 10, 2014 at 16:13
  • 1
    $\begingroup$ How'd you find the correct expression for the spiral? (Is there a standard expression? I don't know much about spirals...) $\endgroup$
    – C. E.
    May 10, 2014 at 16:18
  • 1
    $\begingroup$ @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. $\endgroup$
    – Kuba
    May 10, 2014 at 16:19
  • 2
    $\begingroup$ And if this won't become a hot network question then I would be quite surprised :D $\endgroup$
    – Yves Klett
    May 10, 2014 at 19:26
  • 2
    $\begingroup$ Nice! Interesting music too. Stockhausen would be proud of you. $\endgroup$ May 11, 2014 at 19:23
9
$\begingroup$

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]

enter image description here

$\endgroup$
1
  • $\begingroup$ @Kuba Thanks for the edit. Do you know how to export gif animations from Mathematica? I could only do it with *.swf format. $\endgroup$
    – Ali
    May 10, 2014 at 16:12

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.