Notes

Chapter 5: Two Dimensions and Beyond

Section 4: Substitution Systems and Fractals


Sierpiński 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}, 2n], 2n - 1]
(see page 870)

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

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

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

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

Reverse[Mod[CoefficientList[Series[1/(1 - (1 + x)y), {x, 0, 2n - 1}, {y, 0, 2n - 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 # + } &, {0}, n]]]
(compare page 1005)

Position[Map[Split, NestList[Sort[Flatten[{#, # + 1}]] &, {0}, 2n - 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, 2n - 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]]



Image Source Notebooks:

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