Lindenmayer System

Author

Eric W. Weisstein
October 22, 2008

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Fractals/LindenmayerSystem.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/LindenmayerSystem.html.

©2008 Wolfram Research, Inc. except for portions noted otherwise

Additional Authors

L-system code from
Robert Dickau

http://mathforum.org/advanced/robertd/lsys2d.html

Code

(* carry out the forward and backward moves and the various
    rotations by updating the global location 'Lpos' and
    direction angle 'Ltheta'. *)

Lmove[ z_String, Ldelta_ ] :=
    Switch[ z,
        "+", Ltheta += Ldelta;,
        "-", Ltheta -= Ldelta;,
        "F", Lpos += {Cos[Ltheta], Sin[Ltheta]},
        "B", Lpos -= {Cos[Ltheta], Sin[Ltheta]},
         _ , Lpos += 0. ];

LSystem::usage =
    "LSystem[axiom, {rules}, n, Ldelta:90 Degree]
    creates the L-string for the nth iteration of
    the list 'rules', starting with the string 'axiom'.";

(* make the string: starting with 'axiom', use StringReplace the
    specified number of times *)

LSystem[ axiom_, rules_List,
    n_Integer, Ldelta_:N[90 Degree]] :=
    
    Nest[ StringReplace[#, rules]&, axiom, n ];

Off[General::spell1];

(* initialize the position 'Lpos' and the direction angle 'Ltheta';
    create the Line graphics primitive represented by the L-system by
    mapping 'Lmove' over the characters in the L-string, deleting all the
    Nulls; then show the Graphics object *)

LShow[lstring_String, Ldelta_:N[90 Degree]] :=
   (Lpos={0.,0.};
    Ltheta=0.;
    Show[
      Graphics[Line[
        Prepend[
          DeleteCases[
            Map[Lmove[#, Ldelta]&, Characters[lstring]],
           Null ],
        {0,0}]]],
     AspectRatio -> Automatic]);

(* same as above, plus a list of colors for each segment contained in
    'templist' -- unfortunately, 'templist' isn't really 'temp', but
    stays in memory as a global variable; so sue me *)

LShowColor[lstring_String, Ldelta_:N[90 Degree],opts___] :=
   (Lpos = {0., 0.};
    Ltheta = 0.;
    
    templist =
      Map[ Line,
        Partition[
          Prepend[
            DeleteCases[
              Map[ Lmove[#, Ldelta]&, Characters[lstring] ],
             Null],
           {0,0}],
         2,1]];

    ncol = N[Length[templist]];

    huelist = Table[ Hue[k/ncol], {k, 1., ncol} ];

    Show[
      Graphics[
        N[Flatten[Transpose[{huelist, templist}]]]],
     opts,AspectRatio -> Automatic]);

Examples

lsystems={
{"32\[Hyphen]segment curve","F+F+F+F",{"F"->"-F+F-F-F+F+FF-F+F+FF+F-F-FF+FF-FF+F+F-FF-F-F+FF-F-F+F+F-F+"},2,90},
{"box fractal","F-F-F-F", {"F"->"F-F+F+F-F"},3,90},
{"dragon curve","FX", {"X"->"X+YF+","Y"->"-FX-Y"},10,90},
{"Hilbert curve","L",{"L"->"+RF-LFL-FR+","R"->"-LF+RFR+FL-"},4,90},
{"Hilbert curve II","X",{"X"->"XFYFX+F+YFXFY-F-XFYFX","Y" -> "YFXFY-F-XFYFX+F+YFXFY"},3,90},
{"Koch snowflake","F--F--F", {"F" -> "F+F--F+F"},3,60},
{"Peano curve","F", {"F" -> "F+F-F-F-F+F+F+F-F"},2,90},
{"Peano\[Hyphen]Gosper curve","FX",      {"X"->"X+YF++YF-FX--FXFX-YF+","Y"->"-FX+YFYF++YF+FX--FX-Y"},3,60},
{"quadratic Koch island","F+F+F+F", {"F"->"F-F+F+FFF-F-F+F"},2,90},
{"Sierpiński arrowhead","YF",{"X"->"YF+XF+Y","Y"->"XF-YF-X"}, 5,60},
{"Sierpiński curve","F+XF+F+XF",{"X"->"XF-F+F-XF+F+XF-F+F-X"}, 3,90},
{"Siepiński sieve","FXF--FF--FF",{"F" ->"FF","X"->"--FXF++FXF++FXF--"},4,60}
};

V5

Show[GraphicsArray[
Partition[
Block[{$DisplayFunction=Identity},LShowColor[LSystem@@(Take[#,{2,-2}]),Last[#]Degree//N,PlotLabel->StyleForm[First[#],FontFamily->"Times",FontSlant->"Italic"]]&/@lsystems],
5,5,{1,1},{}]
],ImageSize->500]

V7

GraphicsGrid[
Partition[
LShowColor[LSystem@@(Take[#,{2,-2}]),Last[#]Degree//N,PlotLabel->TextCell[First[#],PageWidth->90,TextAlignment->Center],BaseStyle->{FontFamily->"Times",FontSlant->"Italic"}]&/@lsystems,
5,5,{1,1},{}],ImageSize->500]

GraphicsGrid[
Partition[
LShowColor[LSystem@@(Take[#,{2,-2}]),Last[#]Degree//N,PlotLabel->TextCell[Style[First[#],Italic],PageWidth->90,TextAlignment->Center]]&/@lsystems,
4,4,{1,1},{}],Spacings->50]