6

I am trying to perform the task in Mark McClure's article Parametric L-Systems and borderline fractals. I have copied his opening code on the first three pages:

axiom = {F[1], r[-2 π/3], F[1], r[-2 π/3], F[1]};
KochRule = F[x_] :> {F[x/3], r[π/3], F[x/3], r[-2 π/3], F[x/3], r[π/3], F[x/3]};
instructions = Flatten[Nest[# /. KochRule &, axiom, 5]];
lines = {};
lastpt = {0, 0};
dir = {1, 0};
rotate[θ_] := N[{  {Cos[θ], -Sin[θ]},  {Sin[θ], Cos[θ]}}];
turtleInterpretation = {
   F[x_] :> (lines = {Line[{lastpt, lastpt += x dir}], lines}),
   r[t_] :> (dir = rotate[t].dir;)};
instructions /. turtleInterpretation;
Show[Graphics[lines],
 AspectRatio -> Automatic]

I am using Mathematica 11.1.1 on a MacBook Pro with Sierra OS X. When I evaluated the cell, I got a beep and the following image.

enter image description here

I went to the Help menu and selected "Why the Beep" and got the message

A box structure with a depth exceeding the maximum allowed depth was encountered.

Any suggestions?

Update: I thought I'd share another technique I discovered by examining this page:

str = First@SubstitutionSystem[{"F" -> "F-F++F-F"}, "F++F++F", {6}];
Graphics[Line[
  AnglePath[
   StringCases[
    str, {"F" -> {1, 0}, "+" -> {0, Pi/3}, "-" -> {0, -Pi/3}}]]]]

Gave this image:

enter image description here

David
  • 14,883
  • 4
  • 44
  • 117
  • With Mathematica 8.0.4 on Windows 7 x64 I do not get the beep and error message, but the line isn't rendered completely (as in the question). – Alexey Popkov May 30 '17 at 22:42

2 Answers2

7

Don't know how to alter the limit but the problem comes from:

lines = {Line[{lastpt, lastpt += x dir}], lines}

as it makes lines gain one level for each F occurence.

It is not "strange" though, the reason are linked lists which are faster approach of accumulating data

[...] The idiom lines = {newLine, lines} creates a deeply nested structure but was the old school way to get around the AppendTo [...]

- Mark McClure

See also point 3.3: Performance tuning in Mathematica

The quick fix is:

Show[Graphics[lines // Flatten], AspectRatio -> Automatic]

enter image description here

Community
  • 1
Kuba
  • 136,707
  • 13
  • 279
  • 740
  • 4
    The package was written a long time ago and I'm sure I would do a lot differently now. The idiom lines = {newLine, lines} creates a deeply nested structure but was the old school way to get around the AppendTo approach of dynamically building up a list which is (as I'm sure you know) slow since it rewrites the list with each step. – Mark McClure May 30 '17 at 23:58
  • @MarkMcClure yep, planned to elaborate on that but it was late yesterday. Done now, also included part of your comment, thanks. – Kuba May 31 '17 at 06:01
  • 1
    @Kuba were you able to dig up what setting causes the beep? Initially I assumed it was a $RecursionLimit issue as the Depth of the lines is 3000+ which is greater than the default $RecursionLimit. But that didn't fix it and neither did mucking about with BoxForm`RecursionLimit (although I assume that's an option -- to what I don't know though). – b3m2a1 May 31 '17 at 06:11
  • @MB1965 $RecursionLimit is a kernel feature but the beed happens when rendering takes place I tried Names["F*`*imit*"] but to no avail so I assumed it is somewhere in those FE/system options I don't have time to dig now :) – Kuba May 31 '17 at 06:13
  • 1
    @Kuba good to know. I'd assumed there might be some kernel call in the box formatting, but maybe not. Another failed candidate I found was CurrentValue[$FrontEndSession, "BoxFormattingRecursionLimit"]. – b3m2a1 May 31 '17 at 06:19
3

Kuba already explained this issue well. This is merely a complementary post. To avoid the problem an alternative to Flatten is collecting your results differently. Also you do not need to draw every line segment separately, you can put all the points in a single Line expression.

For example you could use:

turtleInterpretation = {F[x_] :> Sow[x dir], r[t_] :> (dir = rotate[t].dir;)};
raw = Reap[instructions /. turtleInterpretation][[2, 1]];
pts = Accumulate[Prepend[raw, {0, 0}]];

Show[Graphics[Line[pts]], AspectRatio -> Automatic, Frame -> True]

Or we could trivialize the F expressions and write something like:

axiom = {F, r[-2 π/3], F, r[-2 π/3], F};
KochRule = F -> Sequence[F, r[π/3], F, r[-2 π/3], F, r[π/3], F];
iter = 6;
instructions = Nest[# /. KochRule &, axiom, iter];

raw = FoldList[#2.# &, {1, 0}, RotationMatrix @@@ N @ instructions[[2 ;; ;; 2]]];
pts = Accumulate[raw] (1/3)^iter;
AppendTo[pts, First@pts];

Show[Graphics[Line[pts]], AspectRatio -> Automatic]
Mr.Wizard
  • 271,378
  • 34
  • 587
  • 1,371