Notes

Chapter 5: Two Dimensions and Beyond

Section 4: Substitution Systems and Fractals


Sierpinski pattern

Other ways to generate step n of the pattern shown here in various orientations include:

Mod[Array[Binomial, {2, 2}^n, 0], 2] (see pages 611 and 870)

1-Sign[Array[BitAnd, {2, 2}^n, 0]] (see pages 608 and 871)

NestList[Mod[RotateLeft[#] + #, 2] &, PadLeft[{1}, 2^n], 2^n - 1] (see page 870)

NestList[Mod[ListConvolve[{1, 1}, #, -1], 2] &, PadLeft[{1}, 2^n], 2^n - 1] (see page 870)

IntegerDigits[NestList[BitXor[2#, #] &, 1, 2^n - 1], 2, 2^n] (see page 906)

NestList[Mod[Rest[FoldList[Plus, 0, #]], 2] &, Table[1, {2^n}], 2^n - 1] (see page 1034)

Table[PadRight[Mod[CoefficientList[(1 + x)^(t-1), x], 2], 2^n-1], {t, 2^n}] (see pages 870 and 951)

Reverse[Mod[CoefficientList[Series[1/(1 - (1 + x)y), {x, 0, 2^n-1}, {y, 0, 2^n-1}], {x, y}], 2]] (see page 1091)

Nest[Apply[Join, MapThread[Join, {{#, #}, {0 #, #}}, 2]] &, {{1}}, n] (compare page 1073)

The positions of black squares can be found from:

Nest[Flatten[2# /. {x_, y_} -> {{x, y}, {x + 1, y}, {x, y + 1}}, 1] &, {{0, 0}}, n]

Transpose[{Re[#], Im[#]}] &[Flatten[Nest[{2#, 2# + 1, 2# + I} &, {0}, n]]] (compare page 1005)

Position[Map[Split, NestList[Sort[Flatten[{#, # + 1}]] &, {0}, 2^n-1]], _?(OddQ[Length[#]] &), {2}] (see page 358)

Flatten[Table[Map[{t, #} &, Fold[Flatten[{#1, #1 + #2}] &, 0, Flatten[2^(Position[ Reverse[IntegerDigits[t, 2]], 1] - 1)]]], {t, 2^n-1}], 1]] (see page 870)

Map[Map[FromDigits[#, 2]&, Transpose[Partition[#, 2]]]&, Position[Nest[{{#, #}, {#}} &, 1, n], 1] - 1] (see page 509)

A formatting hack giving the same visual pattern is

DisplayForm[Nest[SubsuperscriptBox[#, #, #] &, "1", n]]

From Stephen Wolfram: A New Kind of Science [citation]