First steps toward the Sierpinski carpet

Back to Robert's Math Figures

We start with a square, dividing it into a 3-by-3 grid, and remove the center square; we then repeat the process for each remaining square. The limiting shape (that is, the shape remaining "after" iterating the process an infinite number of times) is the Sierpinski carpet.

The code, for what it's worth: we define a function makehole that takes the lower-left and upper-right corners of a square, and returns a list of eight squares arranged about the center of the original square (that is, it returns the original square with the middle ninth erased); we iterate makehole four times, remembering each step, giving us four lists of corners; the line starting with Show makes the lists of corners into renderable rectangles, which it then shows. It made sense at the time.

makehole[{{x0_, y0_}, {x1_, y1_}}] :=

  With[{xr = Abs[x1 - x0], yr = Abs[y1 - y0]},
    
      { {{x0, y0},               {x0 + xr/3, y0 + yr/3}},
        {{x0, y0 + yr/3},        {x0 + xr/3, y1 - yr/3}},
        {{x0, y1 - yr/3},        {x0 + xr/3, y1}},
        {{x0 + xr/3, y0},        {x1 - xr/3, y0 + yr/3}},
        {{x0 + xr/3, y1 - yr/3}, {x1 - xr/3, y1}},
        {{x1 - xr/3, y0},        {x1, y0 + yr/3}},
        {{x1 - xr/3, y0 + yr/3}, {x1, y1 - yr/3}},
        {{x1 - xr/3, y1 - yr/3}, {x1, y1}}
       }];

Show[
  GraphicsArray[
    Partition[
      Map[ Graphics[#, AspectRatio -> 1]&,
        Apply[
          Rectangle,
            Rest@
              NestList[ Flatten[ Map[ makehole, # ], 1 ]&,
                {{{0, 0}, {1, 1}}},
               4],
         {2}]],
     2]]];

Designed and rendered using Mathematica versions 2.2 and 3.0 for the Apple Macintosh.

[Privacy Policy] [Terms of Use]

Home || The Math Library || Quick Reference || Search || Help 

© 1994-2009 Drexel University. All rights reserved.
http://mathforum.org/
The Math Forum is a research and educational enterprise of the Goodwin College of Professional Studies.