|
%I #4 Mar 30 2012 17:34:22
%S 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,
%T -184,-498,500,610,-500,-498,184,225,10,-25,-2,1
%N 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.
%C 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)}]
%C 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.
%H Michelle Previte and Sean Yang, <a href="http://www.maa.org/pubs/monthly_jan08_toc.html">A Novel Way to Generate Fractals</a>
%F 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}}
%e {1},
%e {1, -1},
%e {1, -2, 1},
%e {1, 2, -1, -2, 1},
%e {1, -2, -7, 6, 20, 6, -7, -2,1},
%e {1, 2, -25, -10, 225, -184, -498, 500, 610, -500, -498,184, 225, 10, -25, -2, 1}
%t 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}]
%Y Cf. A122947, A131218.
%K tabf,uned,sign
%O 1,5
%A _Roger L. Bagula_, Jan 24 2008
|
