Pentagonal spiral in Mathematica

Late to the party~ A slight modification to make them more similar:

steps = AnglePath@Table[{r-0.015 r^2, 1.002*(2 Pi/5)}, {r, .1, 25, 0.1}];
ls=Thread[{Join[ConstantArray[Opacity@1,7],ConstantArray[[email protected],13]],#}]&/@
Partition[Line/@Thread@{Most@steps,Rest@steps},20];
Graphics[{Red, ls}, Background -> Black]

Effect:

close

This solution focused on the perodic color variation and the decrease in the gaps while extruding.


This might do the trick:

Manipulate[
 ParametricPlot[
  #1 {Cos[#2], Sin[#2]} & @@ {t, Log[i] Floor[t]},
  {t, 0, 200}
  , Background -> Black
  , PlotStyle -> Purple
  , Axes -> False
  , PerformanceGoal -> "Quality"
  , PlotRange -> {{-201, 201}, {-201, 201}}
  ],
 {{i, 3.525}, 3.43, 3.6}
]

enter image description here


Since you enjoyed the animation aspect here is nearly verbatim code I wrote 15 years ago:

Animate[ParametricPlot[#1 {Cos[#2], Sin[#2]} & @@ {t, Log[i] Floor[t]}, {t, 0, 200},
   Background -> Black, ImageSize -> 400, PlotPoints -> 150, Axes -> False, 
  PlotRange -> {{-201, 201}, {-201, 201}}], {i, 1, 12.365}, DefaultDuration -> 200, 
 AnimationRepetitions -> 1]

The animation is much too long to practically include as a .GIF here, but I hope you enjoy the patterns that emerge from this simple function.


It's something like this:

steps = Table[{r, 1.001 (2 Pi/5)}, {r, 1, 25, 0.1}];
Graphics[{Red, Line@AnglePath[steps]}, Background -> Black]

Mathematica graphics