3-D L-Systems

Three iterations of generic 3D L-system:

3D Hilbert (space-filling) curve:

Line version of the same thing:

Extruded 2D Hilbert curve:

The ancient 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]

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 the code here, so buy the book.

Designed and rendered using Mathematica versions 2.2 and 3.0 for the Apple Macintosh.

[ home ] || [ 97???? ]