16
$\begingroup$

I'm creating some questions for my math classes. The one below refers to the Sierpinski gasket.

question

I found some great demonstrations to create the gasket. So that's good. Solving the problem is easier to do if the diagram has all the triangles shown, eg. as below...

triangles

I'm wondering if someone could create a function to create the gasket and then switch to a version where all the "little" triangles are shown? I'd like to be able to ask similar questions with the gasket at different levels.

The reason for having ALL the triangles is it lets the student find the fraction of the shaded triangles compared to the total number of small triangles.

Improve this question
$\endgroup$
2
  • 1
    $\begingroup$ Tom, please use the built-in image uploader to host your images instead of on dropbox. This is so that the images will remain even after you delete the file from your dropbox (without them, it's hard to follow the question) $\endgroup$
    – rm -rf ♦
    Jun 25, 2012 at 4:37
  • $\begingroup$ Sorry, didn't know. I need to learn more about how to use StackExchange. Thanks for telling me, I'll edit that. $\endgroup$
    – Tom De Vries
    Jun 26, 2012 at 9:02

4 Answers 4

Reset to default
14
$\begingroup$

Here's an interactive version. 

Manipulate[
 Graphics[{Nest[
    Translate[Scale[#, 1/2, {0, 0}], pts/2] &, {Polygon[pts]}, 
    depth],
   {Brown,
    If[triangles && depth >= 2,
     Nest[Translate[Scale[#, 1/2, Mean[pts]],
        Flatten[{#/2, #/8, -#/4} &@(# - Mean[pts] & /@ pts), 
         1]] &, {Scale[Polygon[pts], 1/4, Mean[pts]]}, depth - 2]]}},
  PlotRange -> {{0, 1}, {0, 1}}, PlotRangePadding -> .2],
 {{pts, {{0, 0}, {1, 0}, {1/2, 1/2 Sqrt[3]}}}, Locator},
 {{depth, 4}, Range[8]},
 {{triangles, False, "Show triangles"}, {True, False}, Checkbox}]

Mathematica graphics

Improve this answer
$\endgroup$
3
  • 2
    $\begingroup$ Wonderfullll +1 $\endgroup$
    – Rojo
    Jun 23, 2012 at 17:18
  • $\begingroup$ Thank you, that's fantastic, and helps to move this from "just a question" to something visually appealing and interactive. Much appreciated! $\endgroup$
    – Tom De Vries
    Jun 23, 2012 at 17:26
  • 1
    $\begingroup$ +1 Excellent usage of geometric transformations. $\endgroup$
    – Vitaliy Kaurov
    Jun 24, 2012 at 6:34
19
$\begingroup$

Here's a quick way to produce a Sierpinski gasket:

With[{n = 4}, (* nesting level *)
 Nest[(# /. poly : Polygon[pts_, ___] :> 
   Map[Function[p, Translate[Scale[poly, 1/2, {0, 0}], p/2]], pts]) &, 
     Graphics[{Polygon[{{Sqrt[3]/2, -1/2}, {0, 1}, {-Sqrt[3]/2, -1/2}}]}],
    n]]

Sierpinski's gasket

Here's a nice triangular grid:

With[{n = 7}, 
 Show[Graphics[
   Table[Polygon[TranslationTransform[{Sqrt[3] (i - j/2), 3 j/2}] /@
                 {{Sqrt[3]/2, -1/2}, {0, 1}, {-Sqrt[3]/2, -1/2}}],
         {i, n}, {j, i}]]]]

triangular grid

Improve this answer
$\endgroup$
6
  • $\begingroup$ Thanks, that was fast! So, for a given level, what would I have to change to create NOT the gasket , but the triangle with alternating black and white triangles of the smallest size...? $\endgroup$
    – Tom De Vries
    Jun 23, 2012 at 16:25
  • $\begingroup$ That's surprisingly trickier to do, @Tom. Let me think about it... $\endgroup$
    – J. M.'s eventual burnout ♦
    Jun 23, 2012 at 16:30
  • $\begingroup$ Excellent, much appreciated! $\endgroup$
    – Tom De Vries
    Jun 23, 2012 at 17:23
  • $\begingroup$ I prefer subdividing a triangle than building it out — avoids having to fiddle with the plot range and keeps it the same size. So the function in Nest would be something like # /. Polygon[pts_, ___] :> Polygon /@ (Thread[#1 + Transpose@{##}]/2 & @@@ NestList[RotateRight, #, Length@#] &@pts) & $\endgroup$
    – rm -rf ♦
    Jun 23, 2012 at 17:28
  • $\begingroup$ I choose Heike's answer as "the answer", but I will use this function as well. I'd select both if possible. Thanks for the help, this is a great addition to the question and will be helpful to the students in visualizing the answer. $\endgroup$
    – Tom De Vries
    Jun 23, 2012 at 17:30
11
$\begingroup$

To create the figure with all the triangles you might use this:

n = 7;

Table[{2 j - i, Sqrt[3] i}, {i, 0, n}, {j, i, n}];

Graphics[Polygon /@ Riffle @@@ Partition[%, 2, 1]]

Mathematica graphics

Improve this answer
$\endgroup$
3
  • $\begingroup$ Thanks for that, nice to see different methods for the same question! $\endgroup$
    – Tom De Vries
    Jun 24, 2012 at 13:59
  • $\begingroup$ Wow,your code is always so clean,+1.By the way,how can you find the most proper function every time? $\endgroup$
    – withparadox2
    Jun 26, 2012 at 12:57
  • 1
    $\begingroup$ @paradox2 Thanks. :-) Experience combined with a desire for concise code I suppose. I certainly don't always have the right/cleanest code but I try to learn when I see it, and this site is great resource for learning. It is helpful to think through and see different methods to achieve something as they often have different strengths and weaknesses when approaching a new problem; this is one reason I post as many answers as I do: the exercise of finding a different way benefits me, and I hope the variety of answers benefits others. $\endgroup$
    – Mr.Wizard
    Jun 26, 2012 at 20:47
1
$\begingroup$

Since V 11.1 there is SierpinskiMesh:

GraphicsGrid[{Table[SierpinskiMesh[n, 2], {n, 0, 3}]}]

enter image description here

GraphicsGrid[{Table[SierpinskiMesh[n, 3], {n, 0, 3}]}]

enter image description here

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.