Having trouble with substitution tile at higher iteration levels--> takes forever!

*To*: mathgroup at smc.vnet.net*Subject*: [mg55748] Having trouble with substitution tile at higher iteration levels--> takes forever!*From*: Roger Bagula <rlbagulatftn at yahoo.com>*Date*: Tue, 5 Apr 2005 03:21:30 -0400 (EDT)*Sender*: owner-wri-mathgroup at wolfram.com

This method was gotten by hard work from an article by Dr. Richard Kenyon and gives a definition of a substitution tile as a boundary set. It works fine until level nine. Level 12 has so far been impossible to get. For some reason the rotation seems to work faster on my machine. The reason higher levels are important to me is that the edges get rougher and more factual as the level increases ( unlike the IFS versions of fractal tiles). It has been suggested that a step which eliminates {x,-x} symbol pairs may be the process that is slowing it down by creating large string chains that use much time and memory space. I think we are lucky to have gotten as high a level output as we have at i=11. Any help in reducing the time to get a tile would be appreciated. This tile and others are part of a project to bring tiling code to the web where it can be utilized by more scholars. Here's a text version ( conversion by 5.1): A translation of "The Construction of Self-Similar Tiles", Richard Kenyon, into Mathematica Section 6 Specify the degree nâ?¥3 of the polynomial and the three integer coefficients, pâ?¥0, qâ?¥0, râ?¥1, from the values he gives in Figure 7 page 17. n=3;p=1;q=2;r=1; Determine \[Lambda], the complex expansion coefficient, from the p,q,r coefficients. rule=NSolve[\[Lambda]^n-p \[Lambda]^(n-1)+q \[Lambda]+ r\[Equal]0,\[Lambda]][[3]] \!\(\* RowBox[{\(General::"spell1"\), \(\(:\)\(\ \)\), "\<\"Possible spelling \ error: new symbol name \\\"\\!\\(rule\\)\\\" is similar to existing symbol \\\ \"\\!\\(Rule\\)\\\". \\!\\(\\*ButtonBox[\\\"Moreâ?¦\\\", \ ButtonStyle->\\\"RefGuideLinkText\\\", ButtonFrame->None, \ ButtonData:>\\\"General::spell1\\\"]\\)\"\>"}]\) {\[Lambda]\[Rule]0.696323\[InvisibleSpace]+1.43595 \[ImaginaryI]} Create the mapping transformation rules from the definition of phi at the top of page 16 in Kenyon's paper phi[a]=b;phi[-a]= -b;phi[b]=c;phi[-b]= -c; phi[c]=Flatten[{Table[c,{p}],Table[-a,{r}],Table[-b,{q}]}]; phi[-c]=Flatten[{Table[b,{q}],Table[a,{r}],Table[-c,{p}]}]; Make phi map across arguments of commutator SetAttributes[phi,Listable] Define the commutator of a pair of vectors as he defines in the middle of page 16. commutator[x_Symbol,y_Symbol]:=Flatten[{x,y,-x,-y}]; commutator[x_Symbol,y_List]:=Flatten[{x,y,-x,-Reverse[y]}]; commutator[x_List,y_Symbol]:=Flatten[{x,y,-Reverse[x],-y}]; commutator[x_List,y_List]:=Flatten[{x,y,-Reverse[x],-Reverse[y]}]; Next we need to compose k copies of phi[] over these results for the k's iteration. Nest[] does exactly what we want. Now let's see if it works, let's try to reproduce the tiles in Figure 8. Next take the word in the free group and replace every letter with the numerical vector coordinates to make up the tile. Plot[] the resulting tile, as soon as everything is working and we have the needed list of vectors. Notice how these start looking a little more like Figure 8 of Kenyon's paper. Table[ListPlot[ FoldList[Plus,{0,0}, Flatten[Nest[phi,commutator[b,c], i]]//.{{h___,x_,-x_,t___}\[Rule]{h,t},{h___,-x_,x_, t___}\[Rule]{h,t},{-x_,m___,x_}\[Rule]{m},{x_, m___,-x_}\[Rule]{m}}/.a->{1,0}/.b->{Re[\[Lambda]], Im[\[Lambda]]}/.c->{Re[\[Lambda]^2],Im[\[Lambda]^2]}/.rule], PlotJoined\[Rule]True,Axes\[Rule]False],{i,1,9}]; These tiles are rotated, to roughly match Kenyon's. <<Geometry`Rotations` Table[ListPlot[ FoldList[Plus,{0,0}, Map[Rotate2D[#,(i-1)Pi/2.8,{0,0}]&, Flatten[Nest[phi,commutator[b,c], i]]//.{{h___,x_,-x_,t___}\[Rule]{h,t},{h___,-x_,x_, t___}\[Rule]{h,t},{-x_,m___,x_}\[Rule]{m},{x_, m___,-x_}\[Rule]{m}}/.a->{1,0}/.b->{Re[\[Lambda]], Im[\[Lambda]]}/.c->{Re[\[Lambda]^2], Im[\[Lambda]^2]}/.rule]],PlotJoined\[Rule]True, Axes\[Rule]False],{i,1,9}]; Here's a link to the notebook online. http://f3.grp.yahoofs.com/v1/sI5RQv2ooF-hjsnEstJzYcUN8qnFAItN6APQvrmLWHM8gOfZgQSpqrR8rHpHSCbK_0QWRp8gEmnM77ZjPACVPw/Kenyon%20tile/tileKenyon_level9nopic.nb Roger L. Bagula email: rlbagula at sbcglobal.net or rlbagulatftn at yahoo.com 11759 Waterhill Road, Lakeside, Ca. 92040 telephone: 619-561-0814}