Three-dimensional L-systems

_____________________________________
Back to Robert's Math Figures
_____________________________________
Three iterations of generic 3D L-system:

3D Hilbert (space-filling) curve:

Line version of the same thing:

Extruded 2D Hilbert curve:

The code, such as it is:

Off[General::spell1, General::spell];

(* the 3D rotation matrices *)

RotMatPsi[angle_] :=
    {{ Cos[angle], Sin[angle], 0},
     {-Sin[angle], Cos[angle], 0},
     {0,           0,          1}};

RotMatPsiII[angle_] :=
   {{Cos[angle], -Sin[angle], 0},
    {Sin[angle],  Cos[angle], 0},
    {0,           0,          1}};

RotMatTheta[angle_] :=
    {{ Cos[angle], 0, Sin[angle]},
     { 0,          1, 0         },
     {-Sin[angle], 0, Cos[angle]}};

RotMatThetaII[angle_] :=
   {{Cos[angle], 0, -Sin[angle]},
    {0,          1,  0         },
    {Sin[angle], 0,  Cos[angle]}};

RotMatPhi[angle_] :=
   {{1, 0,          0         },
    {0, Cos[angle], Sin[angle]},
    {0,-Sin[angle], Cos[angle]}};

RotMatPhiII[angle_] :=
   {{1, 0,           0         },
    {0, Cos[angle], -Sin[angle]},
    {0, Sin[angle],  Cos[angle]}};

On[General::spell1, General::spell];

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

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

(* carry out the forward and backward moves and the various
    3D rotations by updating the global location 'Lpos' and
    direction matrix 'Ldir'. *)

Lmove[z_String, Ldelta_] :=

  Switch[z,
    "F", Lpos += First[Transpose[Ldir]],
    "B", Lpos -= First[Transpose[Ldir]],
    "+", Ldir = Ldir . RotMatPsi[Ldelta[[1]]];,
    "-", Ldir = Ldir . RotMatPsiII[Ldelta[[1]]];,
    "^", Ldir = Ldir . RotMatTheta[Ldelta[[2]]];,
    "&", Ldir = Ldir . RotMatThetaII[Ldelta[[2]]];,
    "<", Ldir = Ldir . RotMatPhi[Ldelta[[3]]];,
    ">", Ldir = Ldir . RotMatPhiII[Ldelta[[3]]];,
     _ , Null];

(* initialize the position 'Lpos' and the direction matrix 'Ldir';
    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 Graphics3D object *)

LShow3D[lstring_String,
  Ldelta_:{N[90 Degree], N[90 Degree], N[90 Degree]}] :=

   (Lpos = {0., 0., 0.};
    Ldir = N[IdentityMatrix[3]]; 
    Show[
     Graphics3D[
       Line[
          Prepend[
             DeleteCases[
               (Lmove[#, Ldelta]&) /@ Characters[lstring],
             Null],
          {0, 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 *)

LShowColor3D[lstring_String, 
    Ldelta_:{N[90 Degree], N[90 Degree], N[90 Degree]},
    opts___Rule] := 

   (Lpos = {0., 0., 0.};
    Ldir = N[IdentityMatrix[3]]; 
    templist = 
      Line /@ 
       Partition[
         Prepend[
           DeleteCases[
            (Lmove[#, Ldelta]&) /@ Characters[lstring],
           Null], 
         0, 0, 0}],
       2, 1];
    ncol = N[Length[templist]]; 
    huelist = Table[Hue[k/ncol], {k, 1., ncol}];
    Show[Graphics3D[
      N[Flatten[Transpose[{huelist, templist}]]]],
     AspectRatio -> Automatic, opts]);

(* create just the list of 3D corners, supposing such a thing desirable *)

LCorners3D[lstring_String, 
    Ldelta_:{N[90 Degree], N[90 Degree], N[90 Degree]}] := 

   (Lpos = {0., 0., 0.};
    Ldir = N[IdentityMatrix[3]]; 
    Prepend[DeleteCases[ (Lmove[#, Ldelta]&) /@ 
        Characters[lstring], Null], {0, 0, 0}]);

(* code for the colored-line version of the Hilbert curve *)

LShowColor3D[
  LSystem["X",
    {"X" -> "^<XF^<XFX-F^>>XFX&F+>>XFX-F>X->"}, 4],
     Pi/2.0{1,1,1}, Boxed->False];
Designed and rendered using Mathematica versions 2.2 and 3.0 for the Apple Macintosh.

Hilbert curve axiom and production rule by Stan Wagon, Mathematica in Action (chapter 6), W. H. Freeman and Co., 1991. His code is miles better than mine, so buy the book.

[Privacy Policy] [Terms of Use]

_____________________________________
Home || The Math Library || Quick Reference || Search || Help 
_____________________________________

© 1994-2014 Drexel University. All rights reserved.
http://mathforum.org/
The Math Forum is a research and educational enterprise of the Drexel University School of Education.The Math Forum is a research and educational enterprise of the Drexel University School of Education.

Copyright © 1996/7 Robert M. Dickau