AMERICAN MATHEMATICAL MONTHLY -April 2009:Transformations Between
- To: mathgroup at smc.vnet.net
- Subject: [mg98337] AMERICAN MATHEMATICAL MONTHLY -April 2009:Transformations Between
- From: Roger Bagula <rlbagula at sbcglobal.net>
- Date: Mon, 6 Apr 2009 05:03:02 -0400 (EDT)
- Organization: at&t http://my.att.net/
I haven't had fun like this since I typed in Barnley's original Byte article IFS's. The Fern just blew me away back then! Today this affine rearranged Sierpinski gasket is great work. http://www.geocities.com/rlbagulatftn/barnsley_affine123.gif http://www.geocities.com/rlbagulatftn/barnsley_affine_234.gif http://www.geocities.com/rlbagulatftn/barnsley_affine_134.gif http://www.maa.org/pubs/monthly_apr09_toc.html April 2009 *Transformations Between Self-Referential Sets* By: Michael F. Barnsley mbarnsley at aol.com <mailto:mbarnsley at aol.com> Did you know that there are continuous transformations from a fractal fern onto a filled square? Also, there are functions of a similar wild character that map from a filled triangle onto itself. We prove that these /fractal transformations/ may be homeomorphisms, under simple conditions, and that they may be calculated readily by means of a coupled Chaos Game. We illustrate several examples of these beautiful functions and show how they exemplify basic notions in topology, probability, analysis, and geometry. Thus they are worthy of the attention of the mathematics community, both for aesthetic and pedagogical reasons. Mathematica: Clear[f, dlst, pt, cr, ptlst, M, p, a, b, c] n0 = 3; dlst = Table[ Random[Integer, {1, n0}], {n, 100000}]; a = 0.65; b = 0.3; c = 0.4; M = {{{-1 + b, -1/2 + b/2 + a/2}, {0, a}}, {{b + c/ 2 - 1/2, b/2 - c/4 + 1/4}, {1 - c, c/2 - 1/2}}, {{c/2, -1/2 + a/2 - \ c/4}, {-c, -1 + a + c/2}}, {{b + c/2 - 1/2, -3/4 + b/4 + a/2 - 1/4}, { 1 - c, a - 1/2 - c/4}}} in = {{1 - b, 0}, {1 - b, 0}, {1/2, 1}, {1 - b, 0}}; Length[in] f[j_, {x_, y_}] := M[[j]]. {x, y} + in[[j]] pt = {0.5, 0.5}; cr[n_] := Flatten[Table[If[i == j == k == 1, {}, RGBColor[i, j, k]], {i, 0, 1}, {j, 0, 1}, {k, 0, 1}]][[1 + Mod[n, 7]]]; ptlst[n_] := Table[{cr[dlst[[j]]], Point[pt = f[dlst[[j]], Sequence[pt]]]}, {j, Length[dlst]}]; Show[Graphics[Join[{PointSize[.001]}, ptlst[n]]], AspectRatio -> Automatic, PlotRange -> All]
