Sierpinski Carpet

Start with a square, dividing it into a 3-by-3 grid, and remove the center square; 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.

(Compare the generation process with the 2-D Cantor dust process and the 3-D Menger sponge process. You might also enjoy the Jerusalem square part of this Jerusalem cube page.)

Some ancient code, for what it’s worth: 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); iterate makehole four times, remembering each step, giving 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 long ago using Mathematica versions 2.2 and 3.0 for the Apple Macintosh.

[ home ] || [ 97???? ]