Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Generating the Sierpinski triangle iteratively in Mathematica?

I have written code which draws the Sierpinski fractal. It is really slow since it uses recursion. Do any of you know how I could write the same code without recursion in order for it to be quicker? Here is my code:

 midpoint[p1_, p2_] := Mean[{p1, p2}]
 trianglesurface[A_, B_, C_] :=  Graphics[Polygon[{A, B, C}]]
 sierpinski[A_, B_, C_, 0] := trianglesurface[A, B, C]
 sierpinski[A_, B_, C_, n_Integer] :=
 Show[
 sierpinski[A, midpoint[A, B], midpoint[C, A], n - 1],
 sierpinski[B, midpoint[A, B], midpoint[B, C], n - 1],
 sierpinski[C, midpoint[C, A], midpoint[C, B], n - 1]
 ]

edit:

I have written it with the Chaos Game approach in case someone is interested. Thank you for your great answers! Here is the code:

 random[A_, B_, C_] := Module[{a, result},
 a = RandomInteger[2];
 Which[a == 0, result = A,
 a == 1, result = B,
 a == 2, result = C]]

 Chaos[A_List, B_List, C_List, S_List, n_Integer] :=
 Module[{list},
 list = NestList[Mean[{random[A, B, C], #}] &, 
 Mean[{random[A, B, C], S}], n];
 ListPlot[list, Axes -> False, PlotStyle -> PointSize[0.001]]]
like image 284
John Avatar asked Jan 30 '12 18:01

John


People also ask

How do you program a Sierpinski triangle?

The procedure for drawing a Sierpinski triangle by hand is simple. Start with a single large triangle. Divide this large triangle into three new triangles by connecting the midpoint of each side. Ignoring the middle triangle that you just created, apply the same procedure to each of the three corner triangles.

What is the pattern in Sierpinski triangle?

The Sierpinski triangle may be constructed from an equilateral triangle by repeated removal of triangular subsets: Start with an equilateral triangle. Subdivide it into four smaller congruent equilateral triangles and remove the central triangle. Repeat step 2 with each of the remaining smaller triangles infinitely.

What is the area of Sierpinski's Triangle after infinite iterations?

Notice that the more iterations performed, the smaller the area becomes. In other words, as n increases to infinity, the area decreases to 0. Thus, we say that the Sierpinski Triangle has an area of 0.

What is the Sierpinski algorithm?

Source code (Sierpinski triangle)The algorithm starts with the vertices of a triangle and subdivides this triangle into three smaller triangles in the subdivide function. Then the subdivide function recursively calls itself for each of the new triangles and repeats the process.


4 Answers

This uses Scale and Translate in combination with Nest to create the list of triangles.

Manipulate[
  Graphics[{Nest[
    Translate[Scale[#, 1/2, {0, 0}], pts/2] &, {Polygon[pts]}, depth]}, 
   PlotRange -> {{0, 1}, {0, 1}}, PlotRangePadding -> .2],
  {{pts, {{0, 0}, {1, 0}, {1/2, 1}}}, Locator},
  {{depth, 4}, Range[7]}]

Mathematica graphics

like image 130
Heike Avatar answered Oct 24 '22 09:10

Heike


If you would like a high-quality approximation of the Sierpinski triangle, you can use an approach called the chaos game. The idea is as follows - pick three points that you wish to define as the vertices of the Sierpinski triangle and choose one of those points randomly. Then, repeat the following procedure as long as you'd like:

  1. Choose a random vertex of the trangle.
  2. Move from the current point to the halfway point between its current location and that vertex of the triangle.
  3. Plot a pixel at that point.

As you can see at this animation, this procedure will eventually trace out a high-resolution version of the triangle. If you'd like, you can multithread it to have multiple processes plotting pixels at once, which will end up drawing the triangle more quickly.

Alternatively, if you just want to translate your recursive code into iterative code, one option would be to use a worklist approach. Maintain a stack (or queue) that contains a collection of records, each of which holds the vertices of the triangle and the number n. Initially put into this worklist the vertices of the main triangle and the fractal depth. Then:

  • While the worklist is not empty:
    • Remove the first element from the worklist.
    • If its n value is not zero:
      • Draw the triangle connecting the midpoints of the triangle.
      • For each subtriangle, add that triangle with n-value n - 1 to the worklist.

This essentially simulates the recursion iteratively.

Hope this helps!

like image 30
templatetypedef Avatar answered Oct 24 '22 11:10

templatetypedef


You may try

l = {{{{0, 1}, {1, 0}, {0, 0}}, 8}};
g = {};
While [l != {},
 k = l[[1, 1]];
 n = l[[1, 2]];
 l = Rest[l];
 If[n != 0,
  AppendTo[g, k];
  (AppendTo[l, {{#1, Mean[{#1, #2}], Mean[{#1, #3}]}, n - 1}] & @@ #) & /@
                                                 NestList[RotateLeft, k, 2]
  ]]
Show@Graphics[{EdgeForm[Thin], Pink,Polygon@g}]

And then replace the AppendTo by something more efficient. See for example https://mathematica.stackexchange.com/questions/845/internalbag-inside-compile

enter image description here

Edit

Faster:

f[1] = {{{0, 1}, {1, 0}, {0, 0}}, 8};
i = 1;
g = {};
While[i != 0,
 k = f[i][[1]];
 n = f[i][[2]];
 i--;
 If[n != 0,
  g = Join[g, k];
  {f[i + 1], f[i + 2], f[i + 3]} =
    ({{#1, Mean[{#1, #2}], Mean[{#1, #3}]}, n - 1} & @@ #) & /@ 
                                                 NestList[RotateLeft, k, 2];
  i = i + 3
  ]]
Show@Graphics[{EdgeForm[Thin], Pink, Polygon@g}]
like image 42
Dr. belisarius Avatar answered Oct 24 '22 09:10

Dr. belisarius


Since the triangle-based functions have already been well covered, here is a raster based approach.
This iteratively constructs pascal's triangle, then takes modulo 2 and plots the result.

NestList[{0, ##} + {##, 0} & @@ # &, {1}, 511] ~Mod~ 2 // ArrayPlot

Mathematica graphics

like image 23
Mr.Wizard Avatar answered Oct 24 '22 09:10

Mr.Wizard