(************** Content-type: application/mathematica ************** CreatedBy='Mathematica 5.1' Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. *******************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 37727, 949]*) (*NotebookOutlinePosition[ 38411, 972]*) (* CellTagsIndexPosition[ 38367, 968]*) (*WindowFrame->Normal*) Notebook[{ Cell[BoxData[ \(Clear[Ktile]\)], "Input"], Cell[BoxData[ StyleBox[\(Off[General::spell1]\), "MR"]], "Input"], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["A Translation of\n\"The Construction of Self-Similar Tiles\",\n\ Richard Kenyon, into ", FontSize->18], StyleBox["Mathematica", FontSize->18, FontSlant->"Italic"], StyleBox["\nSubmitted to Math Source by Roger L. Bagula 30 April 2005", FontSize->18] }], "Title"], Cell[CellGroupData[{ Cell[TextData[{ ButtonBox["http://www.math.ubc.ca/~kenyon/papers/index.html", ButtonData:>{ URL[ "http://www.math.ubc.ca/~kenyon/papers/index.html"], None}, ButtonStyle->"Hyperlink"], StyleBox["\n", FontFamily->"Lucida Grande", FontSize->13, FontWeight->"Plain"], StyleBox["The construction of self-similar tilings", FontFamily->"Lucida Grande", FontSize->13], StyleBox[" , ", FontFamily->"Lucida Grande", FontSize->13, FontWeight->"Plain"], StyleBox["Geom. and Func. Analysis", FontFamily->"Lucida Grande", FontSize->13, FontWeight->"Plain", FontVariations->{"Underline"->True}], StyleBox[" 6,(1996):417-488. Thurston showed that the expansion constant of \ a self-similar tiling of the plane must be a complex Perron number (algebraic \ integer strictly larger in modulus than its Galois conjugates except for its \ complex conjugate). Here we prove that, conversely, for every complex Perron \ number there exists a self-similar tiling. We also classify the expansion \ constants for self-similar tilings which have a rotational symmetry of order \ n.", FontFamily->"Lucida Grande", FontSize->13, FontWeight->"Plain"], "\nSection 6: page 15-18" }], "Section", Background->GrayLevel[0.900008]], Cell[CellGroupData[{ Cell["\<\ \"A complex Perron number is an algebraic integer which is strictly \ larger in modulus than its Galois conjugates (the other roots of its minimal \ polynomial), except for its complex conjugate.\"\ \>", "Subsection"], Cell[TextData[StyleBox["List of operations performed in the calculations to \ pick best roots:\n1) Turn polynomial Rule into List,\n2) Get rid of \[Lambda] \ symbols,\n3) Get rid of Real solutions,\n4) Discard roots with negative Arg, \ they just give mirror image tiles of those with positive Arg\n5) Get rid of \ empty lists\n6) Get rid of cases with no complex root remaining\n7) Get rid \ of roots with Modulus less than the root with greatest Modulus, and with \ multiple roots having same greatest modulus", FontSize->12, FontWeight->"Plain", FontVariations->{"CompatibilityType"->0}]], "Subsubsection", Background->GrayLevel[0.900008]], Cell[BoxData[ StyleBox[ RowBox[{ ButtonBox[\(Kenyon' s\ paper\), ButtonData:>{ URL[ "http://arxiv.org/abs/math.MG/9505210"], None}, ButtonStyle->"Hyperlink"], " ", "on", " ", "the", " ", \(\(web\)\(.\)\)}], "Section"]], "Subsubsection"], Cell["\<\ You are advised to evaluate each subsection separately as the \ amount of output is large for each section.\ \>", "Subsubsection", Background->RGBColor[1, 1, 0]] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["\<\ Kenyon Polynomial type: \[Lambda]^n-p \[Lambda]^(n-1)+q \[Lambda]+r \ \>", "SectionFirst", Background->RGBColor[0, 1, 1]], Cell[CellGroupData[{ Cell[" compute a tile from a set of polynomial specifications", \ "Subsubsection"], Cell[BoxData[ \(Ktile[n_, p_, q_, r_, \[Lambda]_] := Module[{}, \[IndentingNewLine]Print[n, "\<,\>", p, "\<,\>", q, "\<,\>", r, "\<,\>", \[Lambda]]; \[IndentingNewLine] (*\ create\ the\ rules\ that\ generate\ the\ edge\ of\ the\ tile\ *) \ \ \[IndentingNewLine]phi[a] = b; phi[\(-a\)] = \ \(-b\); phi[b] = c; phi[\(-b\)] = \ \(-c\); \[IndentingNewLine]phi[c] = Flatten[{Table[c, {p}], Table[\(-a\), {r}], Table[\(-b\), {q}]}]; \[IndentingNewLine]phi[\(-c\)] = Flatten[{Table[b, {q}], Table[a, {r}], Table[\(-c\), {p}]}]; \[IndentingNewLine]phi[s_List] := FixedPoint[ Function[z, Flatten[Split[ z, #1 === \(-#2\) &] /. \[IndentingNewLine]{_, _} \ \[RuleDelayed] Sequence[]] /. {{\(-\((x_)\)\), m___, x_} \[RuleDelayed] {m}, {x_, m___, \(-\((x_)\)\)} \[RuleDelayed] {m}}\ \[IndentingNewLine]], Flatten[Map[phi, Flatten[s]]]]; \[IndentingNewLine]commutator[ x_Symbol, y_Symbol] := Flatten[{x, y, \(-x\), \(-y\)}]; \[IndentingNewLine]commutator[ x_Symbol, y_List] := Flatten[{x, y, \(-x\), \(-Reverse[y]\)}]; \[IndentingNewLine]commutator[ x_List, y_Symbol] := Flatten[{x, y, \(-Reverse[x]\), \(-y\)}]; \[IndentingNewLine]commutator[ x_List, y_List] := Flatten[{x, y, \(-Reverse[x]\), \(-Reverse[y]\)}]; \[IndentingNewLine] (*\ generate\ the\ list\ of\ vectors\ a, b, c, \(-a\), \(-b\), \(-c\)\ that\ make\ up\ the\ tile\ *) \ \ \[IndentingNewLine]edges[i_] := Nest[phi, commutator[b, c], i]; \[IndentingNewLine] (*\ turn\ edges\ into\ verticies\ *) \[IndentingNewLine]verticies[i_] := FoldList[Plus, 0, edges[i]]; \[IndentingNewLine] (*\ turn\ a, b, c\ vectors\ into\ 1, \[Lambda], \[Lambda]^2\ vectors\ and\ then\ \ substitute\ numeric\ value\ for\ \[Lambda]\ *) \[IndentingNewLine]lambdaMap[ i_] := \(\(Map[#/\[Lambda]^\((i - 1)\) &, verticies[i]] /. a -> 1\) /. b \[Rule] \[Lambda]\) /. c \[Rule] \[Lambda]^2; \[IndentingNewLine] (*\ split\ a\ complex\ value\ into\ a\ list\ of\ the\ real\ and\ \ complex\ coefficients, \ for\ ListPlot\ *) \[IndentingNewLine]splitComplex[z_] := {Re[z], Im[z]}; \[IndentingNewLine]Timing[ Table[ListPlot[Map[splitComplex, lambdaMap[i]], PlotJoined \[Rule] True, Axes \[Rule] False], {i, 11, 11}]]\[IndentingNewLine]]\)], "Input"] }, Open ]], Cell[CellGroupData[{ Cell[" pick best roots", "Subsubsection"], Cell[BoxData[ \(CherryPicker[{n_, p_, q_, r_, roots_}] := Module[{s}, \[IndentingNewLine]s = Sort[roots, OrderedQ[{Abs[#1], Abs[#2]}] &]; \[IndentingNewLine]While[\(Abs[ s[\([1]\)]]\)[\([1]\)] < \(Abs[s[\([\(-1\)]\)]]\)[\([1]\)], s = Drop[s, 1]]; \[IndentingNewLine]If[ Length[s] > 1, {}, {n, p, q, r, \(s[\([1]\)]\)[\([1]\)]}]]\)], "Input"], Cell[BoxData[ \( (*\ Make\ array\ of\ roots\ of\ the\ polynomial\ from\ the\ paper*) \)], \ "Input"], Cell[BoxData[ \(\(Kenyonarray = Flatten[Table[{n, p, q, r, NSolve[\[Lambda]^n - p\ \[Lambda]^\((n - 1)\) + q\ \[Lambda] + r \[Equal] 0, \[Lambda]]}, {n, 3, 6}, {p, 0, 3}, {q, 0, 3}, {r, 1, 4}], 3];\)\)], "Input"] }, Open ]], Cell[CellGroupData[{ Cell[" refine the array", "Subsection"], Cell[BoxData[ \(\(Kenyonarray2 = \(\(\(\(\(Kenyonarray /. Rule \[Rule] List\) /. \[IndentingNewLine]List[\[Lambda], x_] \[Rule] x\) /. \[IndentingNewLine]List[_Real] \[Rule] Sequence[]\) /. \[IndentingNewLine]List[x_Complex] \[Rule] If[Arg[x] < 0, List[], List[x]]\) /. \[IndentingNewLine]List[] \[Rule] Sequence[]\) /. \[IndentingNewLine]List[_Integer, _Integer, \ _Integer, _Integer] \[Rule] Sequence[];\)\)], "Input"], Cell[BoxData[ \(\(Kenyonmap = Map[CherryPicker, Kenyonarray2];\)\)], "Input"], Cell[CellGroupData[{ Cell["\<\ apply the tile function to the best complex Perron numbers found\ \ \>", "Subsubsection"], Cell[BoxData[ \(\(Apply[Ktile, Kenyonmap, 2];\)\)], "Input"] }, Open ]] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["First new Polynomial subtype :", FontColor->RGBColor[1, 0, 0]], "\[Lambda]^n-p \[Lambda]^(n-2)+q \[Lambda]+r" }], "SectionFirst", Background->GrayLevel[0.900008]], Cell[CellGroupData[{ Cell["\<\ new substitution tile computed from a set of polynomial \ specifications\ \>", "Subsubsection"], Cell[BoxData[ \(Poly2tile[n_, p_, q_, r_, \[Lambda]_] := Module[{}, \[IndentingNewLine]Print[n, "\<,\>", p, "\<,\>", q, "\<,\>", r, "\<,\>", \[Lambda]]; \[IndentingNewLine] (*\ create\ the\ rules\ that\ generate\ the\ edge\ of\ the\ tile\ *) \ \ \[IndentingNewLine]phi[a] = b; phi[\(-a\)] = \ \(-b\); phi[b] = c; phi[\(-b\)] = \ \(-c\); \[IndentingNewLine]phi[c] = d; phi[\(-c\)] = \ \(-d\); phi[d] = e; phi[\(-d\)] = \ \(-e\); \[IndentingNewLine]phi[e] = Flatten[{Table[e, {p}], Table[\(-a\), {r}], Table[\(-b\), {1}], Table[\(-d\), {q}]}]; \[IndentingNewLine]phi[\(-e\)] = Flatten[{Table[d, {q}], Table[b, {1}], Table[a, {r}], Table[\(-e\), {p}]}]; \[IndentingNewLine]phi[s_List] := FixedPoint[ Function[z, Flatten[Split[ z, #1 === \(-#2\) &] /. \[IndentingNewLine]{_, _} \ \[RuleDelayed] Sequence[]] /. {{\(-\((x_)\)\), m___, x_} \[RuleDelayed] {m}, {x_, m___, \(-\((x_)\)\)} \[RuleDelayed] {m}}\ \[IndentingNewLine]], Flatten[Map[phi, Flatten[s]]]]; \[IndentingNewLine]commutator[ x_Symbol, y_Symbol] := Flatten[{x, y, \(-x\), \(-y\)}]; \[IndentingNewLine]commutator[ x_Symbol, y_List] := Flatten[{x, y, \(-x\), \(-Reverse[y]\)}]; \[IndentingNewLine]commutator[ x_List, y_Symbol] := Flatten[{x, y, \(-Reverse[x]\), \(-y\)}]; \[IndentingNewLine]commutator[ x_List, y_List] := Flatten[{x, y, \(-Reverse[x]\), \(-Reverse[y]\)}]; \[IndentingNewLine] (*\ generate\ the\ list\ of\ vectors\ a, b, c, \(-a\), \(-b\), \(-c\)\ that\ make\ up\ the\ tile\ *) \ \ \[IndentingNewLine]edges[i_] := Nest[phi, commutator[d, e], i]; \[IndentingNewLine] (*\ turn\ edges\ into\ verticies\ *) \[IndentingNewLine]verticies[i_] := FoldList[Plus, 0, edges[i]]; \[IndentingNewLine] (*\ turn\ a, b, c\ vectors\ into\ 1, \[Lambda], \[Lambda]^2\ vectors\ and\ then\ \ substitute\ numeric\ value\ for\ \[Lambda]\ *) \[IndentingNewLine]lambdaMap[ i_] := \(\(\(\(Map[#/\[Lambda]^\((i - 1)\) &, verticies[i]] /. a -> 1\) /. b \[Rule] \[Lambda]\) /. c \[Rule] \[Lambda]^2\) /. d \[Rule] \[Lambda]^3\) /. e \[Rule] \[Lambda]^4; \[IndentingNewLine] (*\ split\ a\ complex\ value\ into\ a\ list\ of\ the\ real\ and\ \ complex\ coefficients, \ for\ ListPlot\ *) \[IndentingNewLine]splitComplex[z_] := {Re[z], Im[z]}; \[IndentingNewLine]Timing[ Table[ListPlot[Map[splitComplex, lambdaMap[i]], PlotJoined \[Rule] True, Axes \[Rule] False], {i, 11, 11}]]\[IndentingNewLine]]\)], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["pick best roots", "Subsubsection"], Cell[BoxData[ \(CherryPicker[{n_, p_, q_, r_, roots_}] := Module[{s}, \[IndentingNewLine]s = Sort[roots, OrderedQ[{Abs[#1], Abs[#2]}] &]; \[IndentingNewLine]While[\(Abs[ s[\([1]\)]]\)[\([1]\)] < \(Abs[s[\([\(-1\)]\)]]\)[\([1]\)], s = Drop[s, 1]]; \[IndentingNewLine]If[ Length[s] > 1, {}, {n, p, q, r, \(s[\([1]\)]\)[\([1]\)]}]]\)], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["\<\ Make array of roots of the new polynomial based on power 5\ \>", \ "Subsubsection"], Cell[BoxData[ \(\(Poly2array = Flatten[Table[{n, p, q, r, NSolve[\[Lambda]^n - p\ \[Lambda]^\((n - 2)\) + q\ \[Lambda] + r \[Equal] 0, \[Lambda]]}, {n, 3, 6}, {p, 0, 3}, {q, 0, 3}, {r, 0, 4}], 3];\)\)], "Input"], Cell[BoxData[ \(\(Poly2array2 = \(\(\(\(\(Poly2array /. Rule \[Rule] List\) /. \[IndentingNewLine]List[\[Lambda], x_] \[Rule] x\) /. \[IndentingNewLine]List[_Real] \[Rule] Sequence[]\) /. \[IndentingNewLine]List[x_Complex] \[Rule] If[Arg[x] < 0, List[], List[x]]\) /. \[IndentingNewLine]List[] \[Rule] Sequence[]\) /. \[IndentingNewLine]List[_Integer, _Integer, \ _Integer, _Integer] \[Rule] Sequence[];\)\)], "Input"], Cell[BoxData[ \(\(Poly2map = Map[CherryPicker, Poly2array2];\)\)], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["\<\ apply the tile function to the best complex Perron numbers found\ \ \>", "Subsubsection"], Cell[BoxData[ \(\(Apply[Poly2tile, Poly2map, 2];\)\)], "Input"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["\<\ Second new Polynomial subtype :\[Lambda]^n-p \[Lambda]^(n-4)+q \ \[Lambda]+r\ \>", "SectionFirst", Background->GrayLevel[0.900008]], Cell[CellGroupData[{ Cell["\<\ new substitution tile computed from a set of polynomial \ specifications\ \>", "Subsubsection"], Cell[BoxData[ \(Poly3tile[n_, p_, q_, r_, \[Lambda]_] := Module[{}, \[IndentingNewLine]Print[n, "\<,\>", p, "\<,\>", q, "\<,\>", r, "\<,\>", \[Lambda]]; \[IndentingNewLine] (*\ create\ the\ rules\ that\ generate\ the\ edge\ of\ the\ tile\ *) \ \ \[IndentingNewLine]phi[a] = b; phi[\(-a\)] = \ \(-b\); phi[b] = c; phi[\(-b\)] = \ \(-c\); \[IndentingNewLine]phi[c] = d; phi[\(-c\)] = \ \(-d\); phi[d] = e; phi[\(-d\)] = \ \(-e\); \[IndentingNewLine]phi[e] = f; phi[\(-e\)] = \ \(-f\); phi[f] = g; phi[\(-f\)] = \ \(-g\); \[IndentingNewLine]phi[g] = Flatten[{Table[g, {p}], Table[\(-e\), {r}], Table[\(-f\), {q}]}]; \[IndentingNewLine]phi[\(-g\)] = Flatten[{Table[f, {q}], Table[e, {r}], Table[\(-g\), {p}]}]; \[IndentingNewLine]phi[s_List] := FixedPoint[ Function[z, Flatten[Split[ z, #1 === \(-#2\) &] /. \[IndentingNewLine]{_, _} \ \[RuleDelayed] Sequence[]] /. {{\(-\((x_)\)\), m___, x_} \[RuleDelayed] {m}, {x_, m___, \(-\((x_)\)\)} \[RuleDelayed] {m}}\ \[IndentingNewLine]], Flatten[Map[phi, Flatten[s]]]]; \[IndentingNewLine]commutator[ x_Symbol, y_Symbol] := Flatten[{x, y, \(-x\), \(-y\)}]; \[IndentingNewLine]commutator[ x_Symbol, y_List] := Flatten[{x, y, \(-x\), \(-Reverse[y]\)}]; \[IndentingNewLine]commutator[ x_List, y_Symbol] := Flatten[{x, y, \(-Reverse[x]\), \(-y\)}]; \[IndentingNewLine]commutator[ x_List, y_List] := Flatten[{x, y, \(-Reverse[x]\), \(-Reverse[y]\)}]; \[IndentingNewLine] (*\ generate\ the\ list\ of\ vectors\ a, b, c, \(-a\), \(-b\), \(-c\)\ that\ make\ up\ the\ tile\ *) \ \ \[IndentingNewLine]edges[i_] := Nest[phi, commutator[f, g], i]; \[IndentingNewLine] (*\ turn\ edges\ into\ verticies\ *) \[IndentingNewLine]verticies[i_] := FoldList[Plus, 0, edges[i]]; \[IndentingNewLine] (*\ turn\ a, b, c\ vectors\ into\ 1, \[Lambda], \[Lambda]^2\ vectors\ and\ then\ \ substitute\ numeric\ value\ for\ \[Lambda]\ *) \[IndentingNewLine]lambdaMap[ i_] := \(\(\(\(\(\(Map[#/\[Lambda]^\((i - 1)\) &, verticies[i]] /. a -> 1\) /. b \[Rule] \[Lambda]\) /. c \[Rule] \[Lambda]^2\) /. d \[Rule] \[Lambda]^3\) /. e \[Rule] \[Lambda]^4\) /. f \[Rule] \[Lambda]^5\) /. g \[Rule] \[Lambda]^6; \[IndentingNewLine] (*\ split\ a\ complex\ value\ into\ a\ list\ of\ the\ real\ and\ \ complex\ coefficients, \ for\ ListPlot\ *) \[IndentingNewLine]splitComplex[z_] := {Re[z], Im[z]}; \[IndentingNewLine]Timing[ Table[ListPlot[Map[splitComplex, lambdaMap[i]], PlotJoined \[Rule] True, Axes \[Rule] False], {i, 11, 11}]]\[IndentingNewLine]]\)], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["pick best roots", "Subsubsection"], Cell[BoxData[ \(CherryPicker[{n_, p_, q_, r_, roots_}] := Module[{s}, \[IndentingNewLine]s = Sort[roots, OrderedQ[{Abs[#1], Abs[#2]}] &]; \[IndentingNewLine]While[\(Abs[ s[\([1]\)]]\)[\([1]\)] < \(Abs[s[\([\(-1\)]\)]]\)[\([1]\)], s = Drop[s, 1]]; \[IndentingNewLine]If[ Length[s] > 1, {}, {n, p, q, r, \(s[\([1]\)]\)[\([1]\)]}]]\)], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["\<\ Make array of roots of the new polynomial based on power 7\ \>", \ "Subsubsection"], Cell[BoxData[ \(\(Poly3array = Flatten[Table[{n, p, q, r, NSolve[\[Lambda]^n - p\ \[Lambda]^\((n - 4)\) + q\ \[Lambda] + r \[Equal] 0, \[Lambda]]}, {n, 6, 8}, {p, 0, 3}, {q, 0, 3}, {r, 0, 4}], 3];\)\)], "Input"], Cell[BoxData[ \(\(Poly3array2 = \(\(\(\(\(Poly3array /. Rule \[Rule] List\) /. \[IndentingNewLine]List[\[Lambda], x_] \[Rule] x\) /. \[IndentingNewLine]List[_Real] \[Rule] Sequence[]\) /. \[IndentingNewLine]List[x_Complex] \[Rule] If[Arg[x] < 0, List[], List[x]]\) /. \[IndentingNewLine]List[] \[Rule] Sequence[]\) /. \[IndentingNewLine]List[_Integer, _Integer, \ _Integer, _Integer] \[Rule] Sequence[];\)\)], "Input"], Cell[BoxData[ \(\(Poly3map = Map[CherryPicker, Poly3array2];\)\)], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["\<\ apply the tile function to the best complex Perron numbers \ found\ \>", "Subsubsection"], Cell[BoxData[ \(\(Apply[Poly3tile, Poly3map, 2];\)\)], "Input"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell["\<\ Fractal set Found inside Kenyon tiles by Null Substitutions\ \>", \ "SectionFirst", Background->GrayLevel[0.900008]], Cell[BoxData[ \(Clear[g1, g2, tiling, tile1, tile2, r, g, b, f]\)], "Input"], Cell[CellGroupData[{ Cell[" Kenyon tiles calculated", "Subsubsection"], Cell[BoxData[ \(tile1[n_, p_, q_, r_, \[Lambda]_] := Module[{}, \[IndentingNewLine]\[IndentingNewLine] (*\ create\ the\ rules\ that\ generate\ the\ edge\ of\ the\ tile\ *) \ \ \[IndentingNewLine]phi[a] = b; phi[\(-a\)] = \ \(-b\); phi[b] = c; phi[\(-b\)] = \ \(-c\); \[IndentingNewLine]phi[c] = Flatten[{Table[c, {p}], Table[\(-a\), {r}], Table[\(-b\), {q}]}]; \[IndentingNewLine]phi[\(-c\)] = Flatten[{Table[b, {q}], Table[a, {r}], Table[\(-c\), {p}]}]; \[IndentingNewLine]phi[s_List] := FixedPoint[ Function[z, Flatten[Split[ z, #1 === \(-#2\) &] /. \[IndentingNewLine]{_, _} \ \[RuleDelayed] Sequence[]] /. {{\(-\((x_)\)\), m___, x_} \[RuleDelayed] {m}, {x_, m___, \(-\((x_)\)\)} \[RuleDelayed] {m}}\ \[IndentingNewLine]], Flatten[Map[phi, Flatten[s]]]]; \[IndentingNewLine]commutator[ x_Symbol, y_Symbol] := Flatten[{x, y, \(-x\), \(-y\)}]; \[IndentingNewLine]commutator[ x_Symbol, y_List] := Flatten[{x, y, \(-x\), \(-Reverse[y]\)}]; \[IndentingNewLine]commutator[ x_List, y_Symbol] := Flatten[{x, y, \(-Reverse[x]\), \(-y\)}]; \[IndentingNewLine]commutator[ x_List, y_List] := Flatten[{x, y, \(-Reverse[x]\), \(-Reverse[y]\)}]; \[IndentingNewLine] (*\ generate\ the\ list\ of\ vectors\ a, b, c, \(-a\), \(-b\), \(-c\)\ that\ make\ up\ the\ tile\ *) \ \ \[IndentingNewLine]edges[i_] := Nest[phi, commutator[b, c], i]; \[IndentingNewLine] (*\ turn\ edges\ into\ verticies\ *) \[IndentingNewLine]verticies[i_] := FoldList[Plus, 0, edges[i]]; \[IndentingNewLine] (*\ turn\ a, b, c\ vectors\ into\ 1, \[Lambda], \[Lambda]^2\ vectors\ and\ then\ \ substitute\ numeric\ value\ for\ \[Lambda]\ *) \[IndentingNewLine]lambdaMap[ i_] := \(\(Map[#/\[Lambda]^\((i - 1)\) &, verticies[i]] /. a -> 1\) /. b \[Rule] \[Lambda]\) /. c \[Rule] \[Lambda]^2; \[IndentingNewLine] (*\ split\ a\ complex\ value\ into\ a\ list\ of\ the\ real\ and\ \ complex\ coefficients, \ for\ ListPlot\ *) \[IndentingNewLine]splitComplex[z_] := {Re[z], Im[z]}; \[IndentingNewLine]Timing[ Table[ListPlot[Map[splitComplex, lambdaMap[i]], PlotJoined \[Rule] True, Axes \[Rule] False, PlotStyle \[Rule] {RGBColor[0, 0, 1]}], {i, 14, 14}]]\[IndentingNewLine]]\)], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["\<\ Kenyon tiles with first substitution set to zero: fractal subset, \ one of three possible\ \>", "Subsubsection"], Cell[BoxData[ \(tile2[n_, p_, q_, r_, \[Lambda]_] := Module[{}, \[IndentingNewLine]\[IndentingNewLine] (*\ create\ the\ rules\ that\ generate\ the\ edge\ of\ the\ tile\ *) \ \ \[IndentingNewLine]phi[a] = b; phi[\(-a\)] = \ \(-b\); phi[b] = c; phi[\(-b\)] = \ \(-c\); \[IndentingNewLine]phi[c] = Flatten[{Table[c, {p}], Table[\(-a\), {r}], Table[\(-b\), {q}]}]; \[IndentingNewLine]phi[\(-c\)] = Flatten[{Table[b, {q}], Table[a, {r}], Table[\(-c\), {p}]}]; \[IndentingNewLine]phi[s_List] := FixedPoint[ Function[z, Flatten[Split[ z, #1 === \(-#2\) &] /. \[IndentingNewLine]{_, _} \ \[RuleDelayed] Sequence[]] /. {{\(-\((x_)\)\), m___, x_} \[RuleDelayed] {m}, {x_, m___, \(-\((x_)\)\)} \[RuleDelayed] {m}}\ \[IndentingNewLine]], Flatten[Map[phi, Flatten[s]]]]; \[IndentingNewLine]commutator[ x_Symbol, y_Symbol] := Flatten[{x, y, \(-x\), \(-y\)}]; \[IndentingNewLine]commutator[ x_Symbol, y_List] := Flatten[{x, y, \(-x\), \(-Reverse[y]\)}]; \[IndentingNewLine]commutator[ x_List, y_Symbol] := Flatten[{x, y, \(-Reverse[x]\), \(-y\)}]; \[IndentingNewLine]commutator[ x_List, y_List] := Flatten[{x, y, \(-Reverse[x]\), \(-Reverse[y]\)}]; \[IndentingNewLine] (*\ generate\ the\ list\ of\ vectors\ a, b, c, \(-a\), \(-b\), \(-c\)\ that\ make\ up\ the\ tile\ *) \ \ \[IndentingNewLine]edges[i_] := Nest[phi, commutator[b, c], i]; \[IndentingNewLine] (*\ turn\ edges\ into\ verticies\ *) \[IndentingNewLine]verticies[i_] := FoldList[Plus, 0, edges[i]]; \[IndentingNewLine] (*\ turn\ a, b, c\ vectors\ into\ 1, \[Lambda], \[Lambda]^2\ vectors\ and\ then\ \ substitute\ numeric\ value\ for\ \[Lambda]\ *) \[IndentingNewLine]lambdaMap[ i_] := \(\(Map[#/\[Lambda]^\((i - 1)\) &, verticies[i]] /. a \[Rule] 0\) /. b \[Rule] \[Lambda]\) /. c \[Rule] \[Lambda]^2; \[IndentingNewLine] (*\ split\ a\ complex\ value\ into\ a\ list\ of\ the\ real\ and\ \ complex\ coefficients, \ for\ ListPlot\ *) \[IndentingNewLine]splitComplex[z_] := {Re[z], Im[z]}; \[IndentingNewLine]Timing[ Table[ListPlot[Map[splitComplex, lambdaMap[i]], PlotJoined \[Rule] True, Axes \[Rule] False, PlotStyle \[Rule] {RGBColor[1, 0, 0]}], {i, 14, 14}]]\[IndentingNewLine]]\)], "Input"], Cell[BoxData[ \(CherryPicker[{n_, p_, q_, r_, roots_}] := Module[{s}, \[IndentingNewLine]s = Sort[roots, OrderedQ[{Abs[#1], Abs[#2]}] &]; \[IndentingNewLine]While[\(Abs[ s[\([1]\)]]\)[\([1]\)] < \(Abs[s[\([\(-1\)]\)]]\)[\([1]\)], s = Drop[s, 1]]; \[IndentingNewLine]If[ Length[s] > 1, {}, {n, p, q, r, \(s[\([1]\)]\)[\([1]\)]}]]\)], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["\<\ A complex Perron number is an algebraic integer which is strictly \ larger in modulus than its Galois conjugates (the other roots of its minimal polynomial), except for its complex conjugate.\ \>", "Subsubsection"], Cell[BoxData[ \(\(aa = Flatten[Table[{n, p, q, r, NSolve[\[Lambda]^n - p\ \[Lambda]^\((n - 1)\) + q\ \[Lambda] + r \[Equal] 0, \[Lambda]]}, {n, 4, 4}, {p, 0, 2}, {q, 0, 2}, {r, 1, 2}], 3];\)\)], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["\<\ Turn Rule into List, Get rid of \[Lambda] symbols, Get rid of Real solutions, Discard roots with negative Arg, they just give mirror image tiles of those \ with positive Arg Get rid of empty lists Get rid of cases with no complex root remaining\ \>", "Subsubsection"], Cell[BoxData[ \(\(bb = \(\(\(\(\(aa /. Rule \[Rule] List\) /. \[IndentingNewLine]List[\[Lambda], x_] \[Rule] x\) /. \[IndentingNewLine]List[_Real] \[Rule] Sequence[]\) /. \[IndentingNewLine]List[x_Complex] \[Rule] If[Arg[x] < 0, List[], List[x]]\) /. \[IndentingNewLine]List[] \[Rule] Sequence[]\) /. \[IndentingNewLine]List[_Integer, _Integer, \ _Integer, _Integer] \[Rule] Sequence[];\)\)], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["\<\ Now get rid of roots with Modulus less than the root with greatest \ Modulus, and with multiple roots having same greatest modulus\ \>", \ "Subsubsection"], Cell[CellGroupData[{ Cell[BoxData[ \(cc = Map[CherryPicker, bb]\)], "Input"], Cell[BoxData[ \({{}, {}, {4, 0, 1, 1, \(\(0.7271360844911968`\)\(\[InvisibleSpace]\)\) + 0.9340992894605294`\ \[ImaginaryI]}, {4, 0, 1, 2, \(\(0.8498484277930546`\)\(\[InvisibleSpace]\)\) + 1.0081728293133245`\ \[ImaginaryI]}, {4, 0, 2, 1, \(\(0.7718445063460382`\)\(\[InvisibleSpace]\)\) + 1.1151425080399373`\ \[ImaginaryI]}, {4, 0, 2, 2, \(\(0.8734091598058491`\)\(\[InvisibleSpace]\)\) + 1.1555574153642656`\ \[ImaginaryI]}, {4, 1, 0, 1, \(\(1.0189127943851557`\)\(\[InvisibleSpace]\)\) + 0.6025654199985989`\ \[ImaginaryI]}, {4, 1, 0, 2, \(\(1.1438673282747363`\)\(\[InvisibleSpace]\)\) + 0.7593012281519778`\ \[ImaginaryI]}, {4, 1, 1, 1, \(\(1.06612094115595`\)\(\[InvisibleSpace]\)\) + 0.8640541908597382`\ \[ImaginaryI]}, {4, 1, 1, 2, \(\(1.1725674783850781`\)\(\[InvisibleSpace]\)\) + 0.9490736428165101`\ \[ImaginaryI]}, {4, 1, 2, 1, \(\(1.1219644269518567`\)\(\[InvisibleSpace]\)\) + 1.0537557742413834`\ \[ImaginaryI]}, {4, 1, 2, 2, \(\(1.2088898362651914`\)\(\[InvisibleSpace]\)\) + 1.1049055526634364`\ \[ImaginaryI]}, {4, 2, 0, 1, \(-0.41964337760708054`\) + 0.6062907292071994`\ \[ImaginaryI]}, {4, 2, 0, 2, \(\(1.5290855136357462`\)\(\[InvisibleSpace]\)\) + 0.2570658641216778`\ \[ImaginaryI]}, {4, 2, 1, 1, \(\(1.4735614833535067`\)\(\[InvisibleSpace]\)\) + 0.4447718087620663`\ \[ImaginaryI]}, {4, 2, 1, 2, \(\(1.5655258402719652`\)\(\[InvisibleSpace]\)\) + 0.6207618837261815`\ \[ImaginaryI]}, {4, 2, 2, 1, \(\(1.5290855136357462`\)\(\[InvisibleSpace]\)\) + 0.7429341358783229`\ \[ImaginaryI]}, {4, 2, 2, 2, \(\(1.605043404344297`\)\(\[InvisibleSpace]\)\) + 0.8350786686647403`\ \[ImaginaryI]}}\)], "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Discard empty lists", "Subsubsection"], Cell[CellGroupData[{ Cell[BoxData[ \(% /. List[] \[Rule] Sequence[] // TableForm\)], "Input"], Cell[BoxData[ TagBox[GridBox[{ {"4", "0", "1", "1", \(\(\(0.7271360844911968`\)\(\[InvisibleSpace]\)\) + 0.9340992894605294`\ \[ImaginaryI]\)}, {"4", "0", "1", "2", \(\(\(0.8498484277930546`\)\(\[InvisibleSpace]\)\) + 1.0081728293133245`\ \[ImaginaryI]\)}, {"4", "0", "2", "1", \(\(\(0.7718445063460382`\)\(\[InvisibleSpace]\)\) + 1.1151425080399373`\ \[ImaginaryI]\)}, {"4", "0", "2", "2", \(\(\(0.8734091598058491`\)\(\[InvisibleSpace]\)\) + 1.1555574153642656`\ \[ImaginaryI]\)}, {"4", "1", "0", "1", \(\(\(1.0189127943851557`\)\(\[InvisibleSpace]\)\) + 0.6025654199985989`\ \[ImaginaryI]\)}, {"4", "1", "0", "2", \(\(\(1.1438673282747363`\)\(\[InvisibleSpace]\)\) + 0.7593012281519778`\ \[ImaginaryI]\)}, {"4", "1", "1", "1", \(\(\(1.06612094115595`\)\(\[InvisibleSpace]\)\) + 0.8640541908597382`\ \[ImaginaryI]\)}, {"4", "1", "1", "2", \(\(\(1.1725674783850781`\)\(\[InvisibleSpace]\)\) + 0.9490736428165101`\ \[ImaginaryI]\)}, {"4", "1", "2", "1", \(\(\(1.1219644269518567`\)\(\[InvisibleSpace]\)\) + 1.0537557742413834`\ \[ImaginaryI]\)}, {"4", "1", "2", "2", \(\(\(1.2088898362651914`\)\(\[InvisibleSpace]\)\) + 1.1049055526634364`\ \[ImaginaryI]\)}, {"4", "2", "0", "1", \(\(-0.41964337760708054`\) + 0.6062907292071994`\ \[ImaginaryI]\)}, {"4", "2", "0", "2", \(\(\(1.5290855136357462`\)\(\[InvisibleSpace]\)\) + 0.2570658641216778`\ \[ImaginaryI]\)}, {"4", "2", "1", "1", \(\(\(1.4735614833535067`\)\(\[InvisibleSpace]\)\) + 0.4447718087620663`\ \[ImaginaryI]\)}, {"4", "2", "1", "2", \(\(\(1.5655258402719652`\)\(\[InvisibleSpace]\)\) + 0.6207618837261815`\ \[ImaginaryI]\)}, {"4", "2", "2", "1", \(\(\(1.5290855136357462`\)\(\[InvisibleSpace]\)\) + 0.7429341358783229`\ \[ImaginaryI]\)}, {"4", "2", "2", "2", \(\(\(1.605043404344297`\)\(\[InvisibleSpace]\)\) + 0.8350786686647403`\ \[ImaginaryI]\)} }, RowSpacings->1, ColumnSpacings->3, RowAlignments->Baseline, ColumnAlignments->{Left}], Function[ BoxForm`e$, TableForm[ BoxForm`e$]]]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(Length[cc]\)], "Input"], Cell[BoxData[ \(18\)], "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["\<\ plots showing tile and fractal superimposed on the same scale\ \>", \ "Subsubsection"], Cell[BoxData[ \(Table[ Show[{\(Flatten[Apply[tile1, {cc[\([i]\)]}, 2]]\)[\([2]\)], \(Flatten[ Apply[tile2, {cc[\([i]\)]}, 2]]\)[\([2]\)]}], {i, 3, Length[cc]}]\)], "Input"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[StyleBox["Comments on the Theory behind the new Polynomials \ and the fractal subsets by Roger L. Bagula\n", Background->RGBColor[1, 0, 1]]], "SectionFirst"], Cell["\<\ The way I got the ideas for new higher substitutions and \ polynomials is hard to put together. I had done work on Pisot Theta[0], Theta[1] and Theta[2] trying to get \ IFS tiles. S.R. Hinsley claimed to have a Kenyon tile IFS. I spent several months \ trying to duplicate that. I finally went to the original article and tried from there. Up until \ lately I've had little luck with substitution fractals and tiles.\ \>", "Text"], Cell["\<\ In probably totally unrelated work on minimal surfaces , CMC ( constant mean curvature surfaces), and solitons, I went into the theory of elliptical equations pretty deeply. If we make the Kenyon polynomial into: (dx/dt)2=x^n-p*x^(n-1)+q*x+r Then these algebraic numbers are associated with the cycles of the lattice that the elliptic equation establishes on the plane. That's why the degenerates are lines or quadrilaterals, I suppose. It stills seems strange that this type of cycling behavior should give \ minimal substitutions and tiles. I had thought of using Weierstrass elliptical equations in Weierstrass fractal functions before as Besicovitch-Ursell like functions, but I doubt that would give tiles. The two numbers {g2,g3} map to the complex Perron numbers, I think , for n=3. It gets harder for higher n, but seems to be related to a lattice structure \ of: {a,b,c}-> -{a,b,c} The Complex Perron number z0=x0+I*y0 acts as the self-similar scaling/ affine scaling of the tiles. In IFS terms that comes out like S=scale number=x0/(x02+y02)-I*y0/(x02+y02) z'=S*z+a(i) a(i) are the digit set of the tile. I used that in the Reptiles I \ constructed. This result isn't a \"total\" answer, but it makes the tiles make more sense and my polynomial which is mostly hyper elliptic with substitution symmetry: {a,b,c,d,e}-->- {a,b,c,d,e} Which is the next Prime Galois field level. The Reptiles are the quadratic two symbol version of this: {a,b}->- {a,b} So we have levels: 2,3,5 The next polynomial of Kenyon in Galois field terms would/should be: {a,b,c,d,e,f,g}-> - {a,b,c,d,e,f,g} w2=x^n-p*x^(n-4)+q*x+r At higher levels it appears that negative q at least will give tiles ( I got \ one last night from my elliptical invariant analysis of polynomial). The higher level seem to roughly correspond to Theta(0),Theta(1) and Theta(2) levels of minimal symmetry. \ \>", "Text"], Cell[TextData[{ StyleBox["On the Fractal subsets found for Kenyon tiles using \ Mauldin-Williams theory and null substitutions:\n{1,\[Lambda], \ \[Lambda]^2}->{1,\[Lambda],0},{1, 0, \[Lambda]^2},{0,\[Lambda], \[Lambda]^2}", FontFamily->"Lucida Grande", FontSize->14], StyleBox["\nEssentially this result is like replacing one symbol with a {} \ null substitution. \nAny substitution can be represented as a state machine \ digraph of the Mauldin-Williams type.\nRemoving one vertex seems to result \ in tiles producing fractals.", FontSize->14] }], "Text"], Cell[TextData[{ "Some References:\n Related paper link to Perron Numbers:\n \ ", ButtonBox["http://www.google.com/url?sa=U&start=1&q=http://www.mrlonline.\ org/mrl/2004-011-003/2004-011-003-001.pdf&e=10187", ButtonData:>{ URL[ "http://www.google.com/url?sa=U&start=1&q=http://www.mrlonline.org/mrl/\ 2004-011-003/2004-011-003-001.pdf&e=10187"], None}, ButtonStyle->"Hyperlink"], "\nOr\n", ButtonBox["http://www.mrlonline.org/mrl/2004-011-003/2004-011-003-001.pdf", ButtonData:>{ URL[ "http://www.mrlonline.org/mrl/2004-011-003/2004-011-003-001.pdf"], None}, ButtonStyle->"Hyperlink"], "\nOn Mauldin -Williamd Digraphs:\n \"On the Hausdorff Dimension of \ Some Graphs,\" (with S.C.Williams),Transactions American Mathematical Society \ 298 (2) (1986),793-803.\n", ButtonBox["http://www.math.unt.edu/~mauldin/papers/no60.pdf", ButtonData:>{ URL[ "http://www.math.unt.edu/~mauldin/papers/no60.pdf"], None}, ButtonStyle->"Hyperlink"], "\n\"Hausdorff Dimension in Graph Directed Constructions,\" (with \ S.C.Williams),Transactions American Mathematical Society,309(1988),811-829.\n\ ", ButtonBox["http://www.math.unt.edu/~mauldin/papers/no67.pdf", ButtonData:>{ URL[ "http://www.math.unt.edu/~mauldin/papers/no67.pdf"], None}, ButtonStyle->"Hyperlink"] }], "Text"] }, Open ]] }, Open ]] }, FrontEndVersion->"5.1 for Microsoft Windows", ScreenRectangle->{{0, 1024}, {0, 723}}, WindowSize->{888, 696}, WindowMargins->{{0, Automatic}, {Automatic, 0}}, StyleDefinitions -> "ArticleClassic.nb" ] (******************************************************************* Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. *******************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[1754, 51, 45, 1, 31, "Input"], Cell[1802, 54, 75, 2, 30, "Input"], Cell[CellGroupData[{ Cell[1902, 60, 310, 9, 153, "Title"], Cell[CellGroupData[{ Cell[2237, 73, 1285, 33, 166, "Section"], Cell[CellGroupData[{ Cell[3547, 110, 227, 4, 62, "Subsection"], Cell[3777, 116, 650, 10, 168, "Subsubsection"], Cell[4430, 128, 301, 8, 39, "Subsubsection"], Cell[4734, 138, 174, 4, 49, "Subsubsection"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[4957, 148, 133, 4, 61, "SectionFirst"], Cell[CellGroupData[{ Cell[5115, 156, 82, 1, 33, "Subsubsection"], Cell[5200, 159, 2695, 48, 471, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[7932, 212, 41, 0, 33, "Subsubsection"], Cell[7976, 214, 426, 8, 91, "Input"], Cell[8405, 224, 111, 3, 31, "Input"], Cell[8519, 229, 276, 5, 51, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[8832, 239, 39, 0, 43, "Subsection"], Cell[8874, 241, 559, 9, 131, "Input"], Cell[9436, 252, 81, 1, 31, "Input"], Cell[CellGroupData[{ Cell[9542, 257, 100, 3, 33, "Subsubsection"], Cell[9645, 262, 64, 1, 31, "Input"] }, Open ]] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[9770, 270, 198, 5, 39, "SectionFirst"], Cell[CellGroupData[{ Cell[9993, 279, 105, 3, 33, "Subsubsection"], Cell[10101, 284, 2922, 51, 491, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[13060, 340, 40, 0, 33, "Subsubsection"], Cell[13103, 342, 426, 8, 91, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[13566, 355, 96, 3, 33, "Subsubsection"], Cell[13665, 360, 275, 5, 51, "Input"], Cell[13943, 367, 557, 9, 131, "Input"], Cell[14503, 378, 79, 1, 31, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[14619, 384, 100, 3, 33, "Subsubsection"], Cell[14722, 389, 67, 1, 31, "Input"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[14838, 396, 144, 5, 61, "SectionFirst"], Cell[CellGroupData[{ Cell[15007, 405, 106, 3, 33, "Subsubsection"], Cell[15116, 410, 3079, 54, 531, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[18232, 469, 40, 0, 33, "Subsubsection"], Cell[18275, 471, 426, 8, 91, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[18738, 484, 96, 3, 33, "Subsubsection"], Cell[18837, 489, 275, 5, 51, "Input"], Cell[19115, 496, 557, 9, 131, "Input"], Cell[19675, 507, 79, 1, 31, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[19791, 513, 99, 3, 33, "Subsubsection"], Cell[19893, 518, 67, 1, 31, "Input"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[20009, 525, 130, 5, 61, "SectionFirst"], Cell[20142, 532, 80, 1, 31, "Input"], Cell[CellGroupData[{ Cell[20247, 537, 49, 0, 33, "Subsubsection"], Cell[20299, 539, 2672, 48, 491, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[23008, 592, 123, 3, 33, "Subsubsection"], Cell[23134, 597, 2677, 48, 491, "Input"], Cell[25814, 647, 426, 8, 91, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[26277, 660, 224, 4, 50, "Subsubsection"], Cell[26504, 666, 267, 5, 31, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[26808, 676, 277, 8, 118, "Subsubsection"], Cell[27088, 686, 540, 9, 131, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[27665, 700, 165, 4, 33, "Subsubsection"], Cell[CellGroupData[{ Cell[27855, 708, 59, 1, 31, "Input"], Cell[27917, 711, 1952, 33, 125, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[29918, 750, 44, 0, 33, "Subsubsection"], Cell[CellGroupData[{ Cell[29987, 754, 76, 1, 31, "Input"], Cell[30066, 757, 2629, 56, 266, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[32732, 818, 43, 1, 31, "Input"], Cell[32778, 821, 36, 1, 30, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[32863, 828, 96, 3, 33, "Subsubsection"], Cell[32962, 833, 205, 4, 51, "Input"] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[33216, 843, 174, 2, 58, "SectionFirst"], Cell[33393, 847, 457, 9, 78, "Text"], Cell[33853, 858, 1893, 41, 622, "Text"], Cell[35749, 901, 579, 12, 100, "Text"], Cell[36331, 915, 1368, 30, 180, "Text"] }, Open ]] }, Open ]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)