[Date Index]
[Thread Index]
[Author Index]
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]
Prev by Date:
**Re: Is there a BNF for Mathematica?**
Next by Date:
**Re: Joust in Mathematica**
Previous by thread:
**Re: Re: Fast Access to Installed Packages**
Next by thread:
**Re: AMERICAN MATHEMATICAL MONTHLY -April 2009:Transformations Between**
| |