A134265 Coefficients of the polynomials of a three level Hadamard matrix substitution set based on the game matrix set: MA={{0,1},{1,1}};MB={{1,0},{3,1}} Substitution rule is for m[n]:If[m[n - 1][[i, j]] == 0, {{0, 0}, {0, 0}}, If[m[n - 1][[i, j]] == 1, MA, MB]] Based on the Previte idea of graph substitutions as applied to matrices of graphs in the Fibonacci/ anti-Fibonacci game.

1, 1, -1, 1, -2, 1, 1, 2, -1, -2, 1, 1, -2, -7, 6, 20, 6, -7, -2, 1, 1, 2, -25, -10, 225, -184, -498, 500, 610, -500, -498, 184, 225, 10, -25, -2, 1

Offset

1,5

Comments

m[n_] := Table[Table[If[m[n - 1][[i, j]] == 0, {{0, 0}, {0, 0}}, If[m[n - 1][[i, j]] == 1, ma, {{1, 0}, {3, 1}}]], {j, 1, 2^(n - 1)}], {i, 1, 2^(n - 1)}]

Michelle Previte and Sean Yang say Have you ever wanted to build your own fractal? This article will describe a procedure called a vertex replacement rule that can be used to construct fractals. We also show how one can easily compute the topological and box dimensions of the fractals resulting from vertex replacements.

Links

Table of n, a(n) for n=1..37.

Michelle Previte and Sean Yang, A Novel Way to Generate Fractals

Formula

m[n] = If[m[n - 1][[i, j]] == 0, {{0, 0}, {0, 0}}, If[m[n - 1][[i, j]] == 1, MA, MB]] m[0] = {{1}} m[1] = {{1, 0}, {3, 1}} m[2] = {{0, 1, 0, 0}, {1, 1, 0, 0}, {1, 0, 0, 1}, {3, 1, 1, 1}} m[3] = {{0, 0, 0, 1, 0, 0, 0, 0}, {0, 0, 1, 1, 0, 0, 0, 0}, {0, 1, 0, 1, 0, 0, 0, 0}, {1, 1, 1, 1, 0, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 1}, {1, 1, 0, 0, 0, 0, 1, 1}, {1, 0, 0, 1, 0, 1, 0, 1}, {3, 1, 1, 1, 1, 1, 1, 1}} m[4] = {{0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, {0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1}, {0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1}, {1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1}, {0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1}, {1, 1, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1}, {1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1}, {3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}}

Example

{1},
{1, -1},
{1, -2, 1},
{1, 2, -1, -2, 1},
{1, -2, -7, 6, 20, 6, -7, -2,1},
{1, 2, -25, -10, 225, -184, -498, 500, 610, -500, -498,184, 225, 10, -25, -2, 1}

Mathematica

m[0] = {{1}} m[1] = {{1, 0}, {3, 1}} m[2] = {{0, 1, 0, 0}, {1, 1, 0, 0}, {1, 0, 0, 1}, {3, 1, 1, 1}} m[3] = {{0, 0, 0, 1, 0, 0, 0, 0}, {0, 0, 1, 1, 0, 0, 0, 0}, {0, 1, 0, 1, 0, 0, 0, 0}, {1, 1, 1, 1, 0, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 1}, {1, 1, 0, 0, 0, 0, 1, 1}, {1, 0, 0, 1, 0, 1, 0, 1}, {3, 1, 1, 1, 1, 1, 1, 1}} m[4] = {{0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, {0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1}, {0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1}, {1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1}, {0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1}, {1, 1, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1}, {1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1}, {3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}}; Table[CharacteristicPolynomial[m[i], x], {i, 0, 4}]; a = Join[{{1}}, Table[CoefficientList[CharacteristicPolynomial[m[i], x], x], {i, 0, 4}]]; Flatten[a] (* visualization*) Table[ListDensityPlot[m[i]], {i, 0, 4}]

Crossrefs

Cf. A122947, A131218.

Sequence in context: A103921 A115623 A279044 * A182858 A175077 A001030

Adjacent sequences: A134262 A134263 A134264 * A134266 A134267 A134268

Keyword

tabf,uned,sign

Author

Roger L. Bagula, Jan 24 2008

Status

approved