Complex Analysis, L-systems and Christmas
Question: What is the relation between Lindenmayer systems, complex analysis and recursive lambda functions?
Answer: Snow! (and other fractals)
Inspired by Sander’s recent blog post
about the Koch snowflake in Mathematica I discovered a particularly
short way to implement certain L-systems in Mathematica. The basic idea
is to create an array of complex values of which the argument represents
the direction at that point. Such a list is easily created with complex
multiplication and recursive functions, which can be implemented very
concise with lambda functions. The last step is to use Accumulate to
transform this to a list of point coordinates in the complex plane and
plot this.
Koch snowflake
a=E^(Pi/3I);{Re[#],Im[#]}&/@Accumulate[Flatten[{0,a#,a^5#,-#}&
[Nest[{#,a#,a^5#,#}&,1,3]]]]//Line//Graphics
Penrose snowflake
Axiom: Forward, Turn 1/5, Forward, Turn 1/5, Forward, Turn 1/5, Forward, Turn 1/5, Forward.
Rule: Forward, Turn 1/5, Forward, Turn 1/5, Forward, Reverse, Forward, Turn -1/10, Forward, Turn 1/5, Forward
a=Exp[Pi/5I];{Re[#],Im[#]}&/@Accumulate[Flatten[{0,#,a^2#,a^4#,a^6
#,a^8#}&[Nest[{#,a^2#,a^4#,a^9#,a^8#,#}&,1,3]]]]//Line//Graphics
Exterior snowflake
a=Exp[Pi/3I];{Re[#],Im[#]}&/@Accumulate[Flatten[{0,#,a#,a^2#,a^3
#,a^4#,a^5#}&[Nest[{#,a#,#/a,#}&,1,3]]]]//Line//Graphics
Quadratic Koch snowflake
{Re[#],Im[#]}&/@Accumulate[Flatten[{0,#,I#,-#,-I#}&[Nest[{#,-I#,
#,I#,I#,I#,#,-I#,#}&,1,3]]]]//Line//Graphics
Dragon curve
Not a snowflake, but I’m working up to something. This one uses two substitution paths and therefore can’t use iterated lambda functions, but iterated replacement rules work fine:
{Re[#],Im[#]}&/@Accumulate[FoldList[Times,1,Flatten[Nest[#/.{X->
{X,I,Y,1},Y->{1,X,-I,Y}}&,X,11]/.{X->{},Y->{}}]]]//Line//Graphics
Sierpiński arrowhead curve
Still not a snowflake…
a=E^(Pi/3I);{Re[#],Im[#]}&/@Accumulate[FoldList[Times,1,Flatten[
Nest[#/.{X->{Y,1/a,X,1/a,Y},Y->{X,a,Y,a,X}}&,X,6]/.{X->1,Y->1}]]
]//Line//Graphics
Hilbert space-filling curve
Another non-snowflake…
Until now a turn command was always followed by a forward, which is
required for the accumulate trick. However, to implement the Hilbert
space-filling curve I need separate turns and forwards. I came with
the following idea: use a turn of zero degrees (multiply by 1) to
represent a forward, then you will get duplicate entries in the
directions list, which you can filter out with the following command:
&/@Select[Split[],Length[]>1&]//Flatten. I then found a
one-replacement-rule variation of the curve using conjugates of lists to
further shorten the code.
{Re[#],Im[#]}&/@Accumulate[Select[Split[FoldList[Times,1,Nest[{I
,Conjugate[#],1,-I,#,1,#,-I,1,Conjugate[#],I}&,{},5]//Flatten]],
Length[#]>1&]//Flatten]//Line//Graphics
Peano-Gosper flowsnake
Finally, the most difficult snowflake! Or flowsnake as it was called by its inventors. This one involves all the tricks encountered above!
a=E^(Pi/3I);{Re[#],Im[#]}&/@Accumulate[#[[2;;]]&/@Select[Split[
FoldList[Times,1,Nest[#/.{X->{X,a,Y,1,a,a,Y,1,b,1,X,b,b,1,X,1,X,
b,Y,1,a},Y->{b,1,X,a,Y,1,Y,1,a,a,Y,1,a,1,X,b,b,1,X,b,Y}}&,X,4]/.
{b->1/a,X->1,Y->1}//Flatten]],Length[#]>1&]//Flatten]//Line//
Graphics
Conclusion
I donno… Something about Kolmogorov complexities and Hausdorff dimensions?
