(*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 3.0, MathReader 3.0, or any compatible application. The data for the notebook starts with the line of 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[ 13234, 457]*) (*NotebookOutlinePosition[ 14160, 489]*) (* CellTagsIndexPosition[ 14116, 485]*) (*WindowFrame->Normal*) Notebook[{ Cell["\<\ APPM 3010 Fall 1998 Nonlinear Dynamics and Chaos Lab#3 Iterated Function Systems Prof. Keith Julien (c) Prof. Hector E. Lomeli\ \>", "Title", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{ Cell[TextData["Introduction."], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ "In this lab, we will study the attractors of Iterated Functions Systems, \ a.k.a Fractals. The Mathematica package that will be used was written \ originally by ", StyleBox["Rick Moeckel", FontWeight->"Bold"], ", but was modified by your dear professor ", StyleBox["Hector Lomeli", FontWeight->"Bold"], ". The following are some of the fuctions that you will be able to use. As \ before, there is an on-line help for each one of them.\n", StyleBox["plotifs\nplotifsrandom\nsimilarity\nbisimilarity\naffine", FontWeight->"Bold"], "\nDo not forget to set up the directory and load the set of macros IFS." }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(SetDirectory["\"]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(<< "\"\)], "Input"], Cell[TextData[{ "The following IFS have been predefined. \n", StyleBox["sierpinski\nkoch\nsquareholes", FontWeight->"Bold"] }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData["Plotting an IFS. Direct Method."], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ "To plot the attractor of an IFS, we will use ", StyleBox["plotifs[ ]", FontWeight->"Bold"], ". This function can take up to three arguments: an IFS, an initial shape, \ and a number of iterations. If the number of iterations is not specified, \ the function will plot three iterates. The following are several predefined \ initial shapes.\n", StyleBox["segment \ntriangle \nsquare ", FontWeight->"Bold"], " \nFirst we will try plotting the Sierpinski fractal with an initial shape \ of a triangle " }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(plotifs[sierpinski, triangle]\)], "Input", AspectRatioFixed->True], Cell["\<\ If we want only one iteration, we have to type the following. The result \ shows what the basic transformations do. The three little triangles are the \ images of the big one under the three functions of the IFS. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(plotifs[sierpinski, triangle, 1]\)], "Input", AspectRatioFixed->True], Cell["\<\ Now we can increase the number of iterations. The n-th plot will contain 3^n \ small triangles. Try not to use a very large number of iterates.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(plotifs[sierpinski, triangle, 4]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(plotifs[sierpinski, triangle, 5]\)], "Input"], Cell[TextData[ "One of the main theorems about IFS was that the initial shape does not \ matter. You can try out other initial shapes to test this. With only 5 \ iterations they still look somewhat different but they are beginning to look \ like the attractor"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(plotifs[sierpinski, square, 5]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(plotifs[sierpinski, segment, 5]\)], "Input"], Cell[TextData[ "Now try out some other IFS. First another Sierpinski gasket. This IFS has \ 8 functions so its n-th iterate has 8^n functions. Don't set n too high!"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(plotifs[squarehole, square, 1]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(plotifs[squarehole, square]\)], "Input"], Cell[BoxData[ \(plotifs[squarehole, square, 4]\)], "Input"], Cell[TextData["Now we will try with the famous Koch curve."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(plotifs[koch, segment]\)], "Input", AspectRatioFixed->True], Cell[TextData[ "As before you can experiment with different initial shapes and number of \ iterates."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(plotifs[koch, triangle, 4]\)], "Input"], Cell[BoxData[ \(plotifs[koch, segment, 5]\)], "Input", AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData["Plotting an IFS. Random Method."], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ "To plot the attractor of an IFS, we can also use ", StyleBox["plotifsrandom", FontWeight->"Bold"], ". This function can take up to four arguments: an IFS, number of \ iterations, initial point, and the number of iterrations to skip. If the \ number of iterations is not specified, the function will plot 1000 iterates \ starting from {0,0}, with an inital skip of 50 points. Notice that no inital \ shapes are needed. Try the following. The more points you try, the better." }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(plotifsrandom[sierpinski]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(plotifsrandom[sierpinski, 5000]\)], "Input"], Cell["Now try different parameters.", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(plotifsrandom[sierpinski, 6000, {1, 1}, 5]\)], "Input", AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[TextData["Definition of an IFS."], "Section", Evaluatable->False, AspectRatioFixed->True], Cell["\<\ We will define each IFS as a list of the names of functions that act on the \ plane. Now you get to design your own fractal by constructing an IFS and \ plotting it. Rather than typing in the formulas for the functions, some \ simple transformations of the plane have been provided. You can create a \ similarity transformation by specifying the scale factor, translation vector \ and rotation angle in degrees. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell["\<\ For example, to create a similarity with scale factor 1/2 which rotates by 45 \ degrees and translates by {3/4,0}, we need to do the following:\ \>", "Text"], Cell[BoxData[ \(\(f1 = similarity[1\/2, {3\/4, 0}, 45]; \)\)], "Input", AspectRatioFixed->True], Cell[TextData[{ "Notice that ", StyleBox["f1", FontWeight->"Bold"], " is a function which can be included in a list of functions specifying \ your IFS.There is a way to create a transformation which scales the x and y \ variables by two different factors, then does the rotation and translation." }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\(f2 = bisimilarity[1\/2, 1\/4, {0, 0}, 0]; \)\)], "Input", AspectRatioFixed->True], Cell[TextData[{ "Notice that we could have defined ", StyleBox["f2", FontWeight->"Bold"], " in the following way:\n", StyleBox[" f2 = bisimilarity[1/2, 1/4]; \n", FontWeight->"Bold"], " In fact, the translation and rotation are optional parameters." }], "Text"], Cell[TextData[{ "Finally one can create a general affine transformation by specifying a 2x2 \ matrix and a translation. The matrix should be a contraction, however. A \ 2x2 matrix in ", StyleBox["Mathematica", FontSlant->"Italic"], " is a list of two vectors which are the two rows of the matrix." }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\(f3 = affine[{{1\/2, \(-\(1\/2\)\)}, {0, 1\/2}}, {3\/2, 0}]; \)\)], "Input", AspectRatioFixed->True], Cell[TextData[ "Now putting these together into an IFS, you can plot the attractor, which is \ not too exciting in this case."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\(ifs = {f1, f2, f3}; \)\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(plotifs[ifs, square, 1]\)], "Input"], Cell[BoxData[ \(plotifs[ifs, square, 5]\)], "Input"], Cell[TextData[ "A more interesting one can be created by adding some rotation to the \ similarities used for the Sierpinski triangle. These have scale 1/2."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(g1 = similarity[1\/2, {0, 0}, 60]; \)\), \(\(g2 = similarity[1\/2, {1\/2, 0}, 60]; \)\), \(\(g3 = similarity[1\/2, {1\/4, \@3\/4}, 60]; \)\), \(\(ifsint = {g1, g2, g3}; \)\), \(plotifs[ifsint, triangle, 1]\)}], "Input", AspectRatioFixed->True], Cell["Now try with more iterates.", "Text"], Cell[BoxData[ \(plotifs[ifsint, triangle, 6]\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell[TextData["An example from the notes."], "Section", Evaluatable->False, AspectRatioFixed->True], Cell["\<\ This example was taken from the notes. First we define the two affine \ contractions.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(h1 = similarity[1\/2]; \nh2 = similarity[1\/2, {1\/2, 0}]; \)], "Input",\ AspectRatioFixed->True], Cell["We form the corresponding IFS in the following way.", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\(example = {h1, h2}; \)\)], "Input", AspectRatioFixed->True], Cell["\<\ Now we define an initial shape. Notice that we close the traingle by typing \ the point (0,0) two times.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(uca = {{0, 0}, {0, 1}, {1\/4, 0}, {0, 0}}\)], "Input", AspectRatioFixed->True], Cell["Here we have the first three iterates of our IFS.", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(plotifs[example, uca, 1]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(plotifs[example, uca, 2]\)], "Input"], Cell[BoxData[ \(plotifs[example, uca, 3]\)], "Input"], Cell["\<\ Take more iterates. The resulting fractal is not very interesting. Sorry...\ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(plotifs[example, uca, 6]\)], "Input", AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell["A variation on the Chaos Game.", "Section"], Cell["\<\ We would like to use the macros that we have to create a variation of the \ Chaos Game. In this case we will have four different points.\ \>", "Text"], Cell[BoxData[ \(p1 = {2, 3}; \np2 = {5, \(-1\)}; \np3 = {\(-3\), 1}; \n p4 = {0, \(-5\)}; \)], "Input"], Cell["\<\ In the Chaos Game, the functions that fenerate the fractal are the affine \ functions that move a vector to the midpoint of the segment that joins it to \ the different fixed points. We can acomplish this in the following way.\ \>", "Text"], Cell[BoxData[ \(h1 = similarity[1/2, p1/2]; \nh2 = similarity[1/2, p2/2]; \n h3 = similarity[1/2, p3/2]; \nh4 = similarity[1/2, p4/2]; \n h5 = similarity[1/2, p5/2]; \)], "Input"], Cell[TextData[{ "The rest is the same. An IFS is defined a s a list of pure functions and \ the attractor is visualized usinf ", StyleBox["plotifs", FontWeight->"Bold"], " and ", StyleBox["plotifsrandom.", FontWeight->"Bold"] }], "Text"], Cell[BoxData[ \(\(game = {h1, h2, h3, h4}; \)\)], "Input"], Cell[BoxData[ \(plotifs[game, square, 1]\)], "Input"], Cell[BoxData[ \(plotifs[game, square, 6]\)], "Input"], Cell[BoxData[ \(plotifsrandom[game]\)], "Input"], Cell[BoxData[ \(plotifsrandom[game, \ 10000]\)], "Input"] }, Closed]] }, FrontEndVersion->"X 3.0", ScreenRectangle->{{0, 1280}, {0, 1024}}, WindowToolbars->{}, CellGrouping->Manual, WindowSize->{1242, 897}, WindowMargins->{{8, Automatic}, {8, Automatic}}, PrivateNotebookOptions->{"ColorPalette"->{RGBColor, 128}}, ShowCellLabel->True, ShowCellTags->False, RenderingOptions->{"ObjectDithering"->True, "RasterDithering"->False}, CharacterEncoding->"XAutomaticEncoding", StyleDefinitions -> "Classroom.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[1709, 49, 199, 9, 256, "Title"], Cell[CellGroupData[{ Cell[1933, 62, 90, 2, 57, "Section"], Cell[2026, 66, 708, 16, 291, "Text"], Cell[2737, 84, 100, 2, 50, "Input"], Cell[2840, 88, 45, 1, 50, "Input"], Cell[2888, 91, 191, 6, 122, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[3116, 102, 108, 2, 37, "Section"], Cell[3227, 106, 606, 14, 210, "Text"], Cell[3836, 122, 88, 2, 50, "Input"], Cell[3927, 126, 285, 6, 67, "Text"], Cell[4215, 134, 91, 2, 50, "Input"], Cell[4309, 138, 216, 5, 48, "Text"], Cell[4528, 145, 91, 2, 50, "Input"], Cell[4622, 149, 65, 1, 50, "Input"], Cell[4690, 152, 320, 6, 67, "Text"], Cell[5013, 160, 89, 2, 50, "Input"], Cell[5105, 164, 64, 1, 50, "Input"], Cell[5172, 167, 229, 5, 48, "Text"], Cell[5404, 174, 89, 2, 50, "Input"], Cell[5496, 178, 60, 1, 50, "Input"], Cell[5559, 181, 63, 1, 50, "Input"], Cell[5625, 184, 117, 2, 29, "Text"], Cell[5745, 188, 81, 2, 50, "Input"], Cell[5829, 192, 159, 4, 29, "Text"], Cell[5991, 198, 59, 1, 50, "Input"], Cell[6053, 201, 84, 2, 50, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[6174, 208, 108, 2, 37, "Section"], Cell[6285, 212, 565, 11, 105, "Text"], Cell[6853, 225, 84, 2, 50, "Input"], Cell[6940, 229, 64, 1, 50, "Input"], Cell[7007, 232, 93, 2, 29, "Text"], Cell[7103, 236, 101, 2, 50, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[7241, 243, 98, 2, 37, "Section"], Cell[7342, 247, 486, 9, 105, "Text"], Cell[7831, 258, 167, 3, 48, "Text"], Cell[8001, 263, 101, 2, 62, "Input"], Cell[8105, 267, 366, 9, 67, "Text"], Cell[8474, 278, 105, 2, 62, "Input"], Cell[8582, 282, 281, 8, 91, "Text"], Cell[8866, 292, 372, 9, 67, "Text"], Cell[9241, 303, 126, 3, 62, "Input"], Cell[9370, 308, 184, 4, 48, "Text"], Cell[9557, 314, 83, 2, 50, "Input"], Cell[9643, 318, 56, 1, 50, "Input"], Cell[9702, 321, 56, 1, 50, "Input"], Cell[9761, 324, 218, 5, 48, "Text"], Cell[9982, 331, 288, 6, 178, "Input"], Cell[10273, 339, 43, 0, 29, "Text"], Cell[10319, 341, 61, 1, 50, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[10417, 347, 103, 2, 37, "Section"], Cell[10523, 351, 157, 5, 28, "Text"], Cell[10683, 358, 120, 3, 99, "Input"], Cell[10806, 363, 115, 2, 28, "Text"], Cell[10924, 367, 83, 2, 47, "Input"], Cell[11010, 371, 177, 5, 28, "Text"], Cell[11190, 378, 100, 2, 63, "Input"], Cell[11293, 382, 113, 2, 28, "Text"], Cell[11409, 386, 83, 2, 47, "Input"], Cell[11495, 390, 57, 1, 47, "Input"], Cell[11555, 393, 57, 1, 47, "Input"], Cell[11615, 396, 147, 4, 28, "Text"], Cell[11765, 402, 83, 2, 47, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[11885, 409, 49, 0, 37, "Section"], Cell[11937, 411, 160, 3, 48, "Text"], Cell[12100, 416, 111, 2, 110, "Input"], Cell[12214, 420, 250, 4, 67, "Text"], Cell[12467, 426, 191, 3, 130, "Input"], Cell[12661, 431, 253, 8, 48, "Text"], Cell[12917, 441, 62, 1, 50, "Input"], Cell[12982, 444, 57, 1, 50, "Input"], Cell[13042, 447, 57, 1, 50, "Input"], Cell[13102, 450, 52, 1, 50, "Input"], Cell[13157, 453, 61, 1, 50, "Input"] }, Closed]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)