Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2009

[Date Index] [Thread Index] [Author Index]

Search the Archive

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