$\begingroup$

After an initial attempt with a Graphics -based solution, it became apparent that raster-based solutions would be far more efficient. Methods based on ArrayPlot work nicely, but I wondered whether image-based manipulations might be the most efficient possible way, given that they would be optimized for precisely the kinds of operations being performed here.

Indeed, the following is an order of magnitude faster than anything I have timed yet, while sharing the expressive clarity of several other answers that have already appeared. Another advantage is that it scales the output resolution to match the depth of the approximation to the carpet.

carpet[n_, white_: 1, black_: 0] := Nest[{ImageAssemble[{{#1, #1, #1}, {#1, #2, #1}, {#1, #1, #1}}], ImageResize[#2, 3 First[ImageDimensions[#2]]]} & @@ # &, Image /@ {{{black}}, {{white}}}, n] // First

It literally pieces all the pixels together, starting with a black pixel ( Image[{{black}}] ) and a white pixel ( Image[{{white}}] )--whose colors you may optionally specify as arguments--reassembling them at each stage in the familiar three by three pattern ( ImageAssemble ) and, preparatory to the next stage, rescaling the central white pixel to match the size ( ImageResize ). (At the end it throws away the upscaled white image.) Here is carpet[7] , a $2187$ by $2187$ image ($0.05$ seconds):

It is an easy exercise to modify this to start with any central image (the "focus") instead of just a white pixel. Under prompting by Mr.Wizard (see comments), I offer the sharpest possible solution. To create it, you need to begin with an image whose dimensions are a power of three and downsize it all the way to one pixel, creating a list of images that will serve as the foci of interest:

i = ExampleData[{"TestImage", "Lena"}]; (* Original image *) n = 3^(k = Floor[Log[3, Min[ImageDimensions[i]]]]); (* Nearest lower power of 3 *) focus = ImageResize[ImageCrop[i, {n, n}] // ImageAdjust, n/3^#] & /@ Range[k, 0, -1]

An attractive Sierpinski carpet is now particularly simple to make. Here is a general implementation with a default black background

carpet[focus_List, background_: Image[{{0}}]] := Fold[ImageAssemble[{{#1, #1, #1}, {#1, #2, #1}, {#1, #1, #1}}] &, background, focus];

and here is an application to the test image:

carpet[focus]

Because this process is so fast, in less than one second we can make carpets of all the example data (assuming they have already been downloaded):