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:
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}
]
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]