Chapter Six:

The Turtle Road to Recursion

6.1 Introducing the Turtle

turtle package

BeginPackage["Turtle`"];

(* This package provides four functions for controlling the movement and orientation of a "turtle" graphics device. It maintains a list of the points visited by the turtle in "path", which can then be manipulated and displayed as a Graphics object. The calling routine must begin by invoking initialize[]; it can end by either showturtlepath, or by its own Show[Graphics[Line[path]], options] command. *)

initialize::usage = "initialize[p:{0, 0}] places the turtle at p (default is {0, 0}), points it in the direction {1, 0}, and sets path to {p}."

showturtlepath::usage = "showturtlepath displays the turtle's path"

right::usage = "right[a] turns the turtle a degrees to the right."

left::usage = "left[a] turns the turtle a degrees to the left."

forward::usage = "forward[s] moves the turtle forward s units, and appends the coordinates of the new position to path."

back::usage = "back[s] moves the turtle back s units, and appends the coordinates of the new position to path.";

Begin["Turtle`Private`"];

initialize[start_:{0,0}] := (X = start; U = {1, 0}; path = {X})
right[a_] :=
 U = {{Cos[aa = a Degree//N], Sin[aa]}, {-Sin[aa], Cos[aa]}} . U
left[a_] := 
 U = {{Cos[aa = a Degree//N], -Sin[aa]}, {Sin[aa], Cos[aa]}} . U

forward[s_] := AppendTo[path, X += s U]

back[s_]    := AppendTo[path, X -= s U]

showturtlepath := Show[Graphics[Line[path]], 
                       PlotRange->All, AspectRatio->1]

End; EndPackage[];

polygon[n_] := ( initialize[];
                 Do[left[360/n]; forward[1], {n}];
                 showturtlepath)

polygon[6]

randomwalk[n_] :=
	(initialize[];
	 Do[left[120 Random[Integer, 2] - 60]; forward[1], {n}];
	 Show[Graphics[{PointSize[.03], Point[{0,0}], Line[path],
			   PointSize[.02], Point[Last[path]]}],
		PlotRange->All, Axes->Automatic])

randomwalk[100]

Faster turtle

BeginPackage["Turtle`"];

(* This package provides four functions for controlling the movement and orientation of a "turtle" graphics device. It maintains a list of the points visited by the turtle in "path", which can then be manipulated and displayed as a Graphics object. The calling routine must begin by invoking initialize[]; it can end by either showturtlepath, or by its own Show[Graphics[Line[path]], options] command. *)

initialize::usage = "initialize[p:{0, 0}] places the turtle at p (default is {0, 0}), points it in the direction {1, 0}, and sets path to {p}."

showturtlepath::usage = "showturtlepath displays the turtle's path"

right::usage = "right[a] turns the turtle a degrees to the right."

left::usage = "left[a] turns the turtle a degrees to the left."

forward::usage = "forward[s] moves the turtle forward s units, and appends the coordinates of the new position to path."

back::usage = "back[s] moves the turtle back s units, and appends the coordinates of the new position to path.";

Begin["Turtle`Private`"];

(* Faster turtle. Calling routine must begin with initialize[] 
and end with either finished or showturtlepath *)

Clear[initialize]

initialize[start_List:{0., 0.}, dim_Integer:1000] :=
          (path = Table[Null, {dim}];
           X = start//N; U = {1., 0.}; path[[1]] = X; count = 1)

right[a_]   :=
U = {{t1 = Cos[aa = a Degree//N], t2 = Sin[aa]}, {-t2, t1}} . U
left[a_]    := right[-a]
forward[s_] :=  path[[++count]] = (X += s U)
back[s_]    :=  forward[-s]
finished    :=  path = Take[path, count]

showturtlepath := (finished;
 Show[Graphics[Line[path]], PlotRange->All, AspectRatio->1];)

End; EndPackage[];

initialize[];
Do[left[120 Random[Integer, 2] - 60]; forward[1], {60}];
showturtlepath

flakeside[length_, 0] := forward[length];

flakeside[length_, depth_] := (
		flakeside[length/3, depth-1];
		left[60];
		flakeside[length/3, depth-1];
		right[120];
		flakeside[length/3, depth-1];
		left[60];
		flakeside[length/3, depth-1]);

KochSnowflake[n_] := (initialize[];
		Do[flakeside[1., n]; right[120], {3}];
		showturtlepath )

6.3 Recursion via String Rewriting

NestList[
 Flatten[# /. "F" -> {"F", "+", "F", "-", "-", "F", "+", "F"}] &,
 {"F"}, 2] //TableForm

symboltable =
	{"F" -> forward, "B" -> back, "-" -> right, "+" -> left};
Map[
 First[Characters[#[[1]]]] -> Characters[#[[2]]] &,
	{"F" -> "F-" , "-" -> "F-B+"}] /. symboltable

Nest[# /. {forward -> {forward, forward}} &, (Characters["+F"] /. 
	symboltable), 3]

WARNING: If you have been using the preceding turtle packages in this session and wish to now use the Recursive Turtle Package that follows, either reboot or execute the following cell.

$ContextPath={"Global`", "System`"}

Recursive Turtle Package

BeginPackage["RecursiveTurtle`"];

RecursiveTurtle::usage = 
"RecursiveTurtle[recursion, axiom, depth, angle, steplength, startposn:{0.,0.}, startdir:{1.,0.}, dim:1000] returns the image obtained by applying a turtle to the sequence of movements generated in depth many rewritings of the axiom. Characters are F, B, -, +. If the path is expected to visit more than 1000 points, a larger value of dim should be used. The rewrite rules in recursion should each transform a single character.";

path::usage = "path contains the turtle's coordinates and may be accessed externally";

Begin["RecursiveTurtle`Private`"];

RecursiveTurtle[recursion_List, axiom_String, depth_Integer,
 angle_, steplength_, startposn_List:{0,0},
 startdir_List:{1,0}, dim_:1000] := (
 
 symboltable = {"F"->forward, "B"->back, "-"->right, "+"->left};

 X = startposn//N; U = startdir//N;
 count = 1;
 c = Cos[angle Degree //N]; s = Sin[angle Degree //N];

 Attributes[turtle] = Listable;
	turtle[forward] := path[[++count]] = (X += steplength U);
	turtle[back]    := path[[++count]] = (X -= steplength U);
	turtle[left]    := U = rotateleft . U;
	turtle[right]   := U = rotateright . U;
		
replacerules =
 Map[First[Characters[#[[1]]]] -> Characters[#[[2]]] &, 
 	recursion] /.  symboltable;

path = Table[Null, {dim}]; path[[1]] = X; 
rotateleft = {{c,-s},{s,c}}; rotateright = Transpose[rotateleft];
turtle[Nest[# /. replacerules &,
	  Characters[axiom]/.symboltable, depth]];
path = Take[path, count];
Show[Graphics[Line[path]], AspectRatio->1, Axes->None,
    	PlotRange->All])

End[]; EndPackage[];

KochSnowflake[n_] :=
   RecursiveTurtle[{"F" -> "F+F--F+F"}, "+F--F--F", n, 60, 3.^-n]

KochSnowflake[2];

RecursiveTurtle[{"F" -> "F-F++F-F"}, "F-F-F-F-F-F", 0, 60, 1.]

depth = 4
RecursiveTurtle[{"F"->"FF", Y -> "F-Y+Y+Y-F"}, "Y-F-F", depth, 	120, 2^(-depth), {0,0}, {.5, Sqrt[.75]}, 1 + 2 * 3 ^ depth]

6.4 A Space-Filling Curve

Hilbert[n_] := Show[
	RecursiveTurtle[{"X" -> "-YF+XFX+FY-", Y -> "+XF-YFY-FX+"},
				"Y", n, 90, 2. ^ -n,  4 ^ n],
AspectRatio->1, PlotRange->{{0, 1}, {0,1}},
Axes->{0,0}, AxesStyle->GrayLevel[1], 
Ticks->{{.25, .5, .75, 1}, {.25, .5, .75, 1}}]

Hilbert[2]

n = 3
RecursiveTurtle[{"X" -> "-YF+XFX+FY-", Y -> "+XF-YFY-FX+"},
				"Y", n, 90, 2. ^ -n,  4 ^ n]

Show[Graphics[Line @ Transpose @ 
	{Range[0., 1 - 4^-n, 4^-n], 
	First@Transpose[path]}],
	Axes->Automatic, AxesLabel->{"t", "x(t)"}]

n = 4
RecursiveTurtle[{"X" -> "-YF+XFX+FY-", Y -> "+XF-YFY-FX+"},
				"Y", n, 90, 2. ^ -n,  4 ^ n]
Show[Graphics3D[Line  [Flatten /@ Transpose @ 
	{Range[0,  1 - 4^-n, 4^-n], path}]],
	Axes->Automatic, AxesLabel->{"t", "x", "y"}];

UltraTurtle package (from Appendix)

BeginPackage["UltraTurtle`"];

UltraTurtle::usage = "UltraTurtle[recursion, axiom, terminal:{0,0}, depth, angle, steplength, startposn:{0.,0.}, startdir:{1.,0.}, dim1:1000, dim2:1] returns the image obtained by applying a turtle to the sequence of movements generated in depth many rewritings of the axiom. Characters are F, B, -, +, i (flip), [ (push), ] (pop). Stack operations and a terminal substitution are supported. 
If the path will visit more than 1000 points, a larger value of dim1 should be used. The number of separate paths must be less than dim2. The final turtle path(s) is in the variable called path, which can be displayed externally via Map[Line, path]";

path;

Begin["UltraTurtle`Private`"];

symboltable = {"F" -> forward, "B" -> back, "-" -> right, 
	"+" -> left, "i" -> flip, "[" -> push, "]" -> pop};

UltraTurtle[recursion_List, axiom_String, terminal_List:{},
		depth_Integer, angle_, steplength_,
		startposn_List:{0., 0.}, startdir_List:{1., 0.},
		dim1_:100, dim2_:1] := Block[
	
	{X,	U, turtle, rotateleft, rotateright, start, replacerules,
 	 symbols, i = 0, stack = {{startposn//N, startdir//N}},
	 c = Cos[angle Degree]//N, s = Sin[angle Degree]//N,
	 count = Table[1, {dim2}]}, 

start = Prepend[Characters[axiom] /. symboltable, pop];

replacerules[r_List] :=
 Map[First[Characters[#[[1]]]] -> Characters[#[[2]]] &, r] /.
	 symboltable;

turtle[left]   :=    U = rotateleft . U;
turtle[right]  :=    U = rotateright . U;
turtle[forward]:=  path[[i, ++count[[i]]]] = (X += steplength U);
turtle[back]   :=  path[[i, ++count[[i]]]] = (X -= steplength U);
turtle[push]   :=    PrependTo[stack, {X, U}];
turtle[pop]    :=   ({X, U} = First[stack]; path[[++i, 1]] = X;
					                 stack = Rest[stack]);
turtle[flip]   :=
		 {rotateleft, rotateright} = {rotateright, rotateleft};
Attributes[turtle] = Listable;

path = Table[Null, {dim2}, {dim1}];
rotateright = Transpose[ rotateleft = {{c, -s}, {s, c}} ];
turtle[
      Nest[# /. replacerules[recursion] &, start/.symboltable, 
      		depth] /. replacerules[terminal]];

path = Map[Take[path[[#]], count[[#]]]&, Range[i]];

Show[Graphics[Line /@ path], AspectRatio->1, Axes->None, 
	PlotRange->All, AspectRatio->1]]

End[]; EndPackage[];

n=4
UltraTurtle[
	{"X" -> "+iXiF-XFX-FiXi+"}, "X", n, 90, 2. ^ -n, 4 ^ n]

n=3
UltraTurtle[{"L" -> "+iLi--L+LiLi-"}, "L",
{"L" -> "+F-FF-F"}, n, 90, 2^-(n+1), 4^(n+1) + 1, 1]

Generation of 3-dim space curve for variation to Hilbert's Curve

HilbertVariation[n_] := Show[UltraTurtle[
	{"R" -> "L+R-R+++L--", "L" -> "R-L+L---R++"},
	"+L",
	{"R" -> "F++F-", "L" -> "F--F+"},
	n, 45, 2^-(n+.5), 1 + 2.^(2n+1)],
PlotRange->{{0,1}, {0,1}}, Axes->Automatic]

HilbertVariation[4]

n = 4
len = 1 + 2 4^n
Show[Graphics3D[Line  [Flatten /@ Transpose @ 
	{Range[0., 1 - 1/len, 1/len], path[[1]]}]],
	Axes->Automatic, AxesLabel->{"t", "x", "y"}]

6.5 Flying a Space Turtle along a Peano Curve

RecursiveTurtle3D package (from Appendix)

BeginPackage["RecursiveTurtle3D`"];

RecursiveTurtle3D::usage = "RecursiveTurtle3D[recursion_List, axiom,
depth_Integer, angles_List, steplength, startposn_List:{0.,0.,0.},
startdir_List:IdentityMatrix[3], dim_:1000] displays the path generated
by depth many applications of the rules in recursion to axiom. The
list, angles, must contain the pitch, roll, & yaw angles in that order.";

path;

Begin["RecursiveTurtle3D`Private`"];

RecursiveTurtle3D[recursion_List, axiom_, depth_Integer, 
	angles_List, 	steplength_, startposn_List:{0.,0.,0.}, 	
	startdir_List:(IdentityMatrix[3]), dim_:1000] :=
	
(X = startposn//N; V = startdir//N;	count = 1;
{cp,cr,cy} = Cos[angles Degree//N]; 
{sp,sr,sy} = Sin[angles Degree//N];

symboltable = {"F"  -> forward,  "B" -> back, 
	              "&"  -> pitch,    "^" -> pitchback, 
	              "\\" -> rollleft, "/" -> rollright,
	              "+"  -> yawleft,  "-" -> yawright    };

turtle[forward] := 
	path[[++count]] = X += steplength First[Transpose@V];
turtle[back]    := 
	path[[++count]] = X -= steplength First[Transpose@V];
turtle[pitch]     := V = V.pitchmatrix;
turtle[pitchback] := V = V.pitchbackmatrix;
turtle[yawleft]   := V = V.yawleftmatrix;
turtle[yawright]  := V = V.yawrightmatrix;
turtle[rollleft]  := V = V.rollleftmatrix;
turtle[rollright] := V = V.rollrightmatrix;
	Attributes[turtle] = Listable;

replacerules =
 Map[First[Characters[#[[1]]]] -> Characters[#[[2]]] &, recursion] /.
											   symboltable;

path = Table[Null, {dim}]; path[[1]] = X; 

pitchmatrix     =  {{cp,  0,  sp}, {0, 1,  0},    {-sp, 0, cp}};
pitchbackmatrix =  {{cp,  0, -sp}, {0, 1,  0},    { sp, 0, cp}};

rollleftmatrix  =  {{1,  0,  0},   {0, cr,  sr},  {0, -sr, cr}};
rollrightmatrix =  {{1,  0,  0},   {0, cr, -sr},  {0,  sr, cr}};

yawleftmatrix   =  {{cy, -sy,  0}, { sy,  cy, 0}, {0, 0, 1}}; 
yawrightmatrix  =  {{cy,  sy,  0}, {-sy, cy,  0}, {0, 0, 1}}; 

turtle[Nest[# /. replacerules &, Characters[axiom]/.symboltable, depth]];
path = Take[path, count];
Show[Graphics3D[Line[path]],
          Axes->None, BoxRatios->{1,1,1}, Boxed->False, PlotRange->All])

End[]; EndPackage[];

k=1
RecursiveTurtle3D[
  {"B" -> "^+/F B \\--\\F B /+ & B"}, "\\FB", k, {90, 45, 45}, 1]

k=3
RecursiveTurtle3D[
  {"B" -> "^+/F B \\--\\F B /+ & B"}, "\\FB", k, {58.28, 31.72, 54}, 1]

Hilbert3D[n_] := Show[RecursiveTurtle3D[
{"X" -> "^\\XF^\\XFX-F^//XFX&F+//XFX-F/X-/"}, "X",
	n, {90, 90, 90}, 2^-n, {2.,2.,2.}^(-n-1)],
Axes->Automatic, PlotRange->{{0,1}, {0,1}, {0,1}}]

Hilbert3D[2]

Hilbert3D[3]

Do[Show[Graphics3D[Line[path],
       ViewPoint->{11 + 12 Cos[-Pi/2 + t Pi/20],
				 -8 + 12 Sin[-Pi/2 + t Pi/20],
				 16 - t}]],	{t, 20}]

6.6 Trees, Mathematical and Botanical

To those who care: The following should have been written with named options instead of defaults the way I used them. Sorry.

StackTurtle[recursion_List, axiom_, depth_Integer, angle_,
	steplength_, startposn_List:{0., 0.},
	startdir_List:{1., 0.}, dim1_:10, dim2_:200] := Block[
	{X,	U, turtle, rotateleft, rotateright,
     symboltable = {"F" -> forward, "B" -> back,
				  "-" -> right, "+" -> left,
                    "[" -> push, "]" -> pop},
	start, replacerules, i = 0,
	stack = {{startposn//N, startdir//N}},
	c = Cos[angle Degree]//N, s = Sin[angle Degree]//N,
	count = Table[1, {dim2}]}, 

start = Prepend[Characters[axiom] /. symboltable, pop];
replacerules = Map[
 Characters[First@#][[1]] -> Characters[#[[2]]] &, recursion] /.
	symboltable;

turtle[left]  :=    U = rotateleft . U;
turtle[right] :=    U = rotateright . U;
turtle[forward] := 
	paths[[i, ++count[[i]]]] = (X += steplength U);
turtle[back] :=
	paths[[i, ++count[[i]]]] = (X -= steplength U);
turtle[push]  :=    PrependTo[stack, {X, U}];
turtle[pop]   :=   ({X, U} = First[stack]; paths[[++i, 1]] = X;
					   stack = Rest[stack]);
Attributes[turtle] = Listable;

paths = Table[Null, {dim2}, {dim1}];
rotateleft = {{c, -s}, {s, c}}; rotateright = {{c, s}, {-s, c}};
turtle[Nest[# /. replacerules &, start, depth]];
paths = Map[Take[paths[[#]], count[[#]]]&, Range[i]];
Show[Graphics[Line /@ paths], AspectRatio->1, Axes->None,
   		 PlotRange->All, AspectRatio->1]]

n = 3;
StackTurtle[
{"F"->"F[+F][-F]"}, "FB", n, 180/7, 1., {0,0},{0,1}, 3, 3^n]

n = 3
StackTurtle[{"F" -> "F[+F]F[-F]F"}, "F", n, 180/7, 1.,
	{0, 0}, {0, 1}, 4, (5^n + 1)/2 ]

n = 2
StackTurtle[{"F" -> "FF+[+F-F-F]-[-F+F+F]"}, "F", n, 180./8, 1.,
	{0, 0}, {0, 1}, 6, (16 8^n + 5)/7]