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

MathGroup Archive 2009

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

Search the Archive

Re: AMERICAN MATHEMATICAL MONTHLY -April 2009:Transformations Between

  • To: mathgroup at smc.vnet.net
  • Subject: [mg98471] Re: AMERICAN MATHEMATICAL MONTHLY -April 2009:Transformations Between
  • From: Roger Bagula <rlbagula at sbcglobal.net>
  • Date: Fri, 10 Apr 2009 04:56:24 -0400 (EDT)
  • References: <grcgfr$pil$1@smc.vnet.net> <grhp5r$mg6$1@smc.vnet.net>

David Bailey wrote:

>
>>
>>
>>    
>>
>Roger,
>
>Which parameter do you vary to go between the two types of fractal - 
>your calculation takes a bit too long to figure this out by guesswork!
>
>David Bailey
>http://www.dbaileyconsultancy.co.uk
>
>  
>

David Bailey
You can speed it up by changing:
dlst = Table[ Random[Integer, {1, n0}], {n, 100000}];
to
dlst = Table[ Random[Integer, {1, n0}], {n, 25000}];

The article uses alpha, beta, gamma:
I use a and b and c instead.

Besides the Sierpinski gasket
a=b=c=1/2
special symmetrical form
there is this one
a=b=c=1/3
and the
a=b=c=2/3
with is the same one rotated.

http://www.geocities.com/rlbagulatftn/triangle3rdsaffine.jpg

The code here is very slow for the better graphics:
remove one zero for a fast result.

Clear[f, dlst, pt, cr, ptlst, M, p, a, b, c, x0, x, y]
n0 = 3;
dlst = Table[ Random[Integer, {1, n0}], {n, 250000}];
rotate[theta_] := {{Cos[theta], -Sin[theta]}, {Sin[theta], Cos[theta]}};
a = b = c = N[1/3]
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}}}
a0 = Table[Det[M[[i]]], {i, 1, 3}]
Apply[Plus, a0]
in = {{1 - b, 0}, {1 - b, 0}, {1/2, 1}};
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: dynamic popupmenu help needed
  • Next by Date: Re: dual y-axis plotting - is it possible in mathematica?
  • Previous by thread: Re: AMERICAN MATHEMATICAL MONTHLY -April 2009:Transformations Between
  • Next by thread: Re: AMERICAN MATHEMATICAL MONTHLY -April 2009:Transformations Between