Search NKS | Online
1 - 10 of 18 for ListConvolve
Spectra [of sequences]
The spectra shown are given by Abs[Fourier[data]] , where the symmetrical second half of this list is dropped in the pictures. … These are related to the autocorrelation function according to
Fourier[list] 2 Fourier[ListConvolve[list, list, {1, 1}]]/Sqrt[Length[list]]
(See also page 1074 .)
Most of these operations are just done by applying ListConvolve with simple kernels. … An example originally popular in the earth and environmental sciences is so-called mathematical morphology, based on "dilation" of data consisting of 0's and 1's with a "structuring element" σ according to Sign[ListConvolve[ σ , data, 1, 0]] (as well as the dual operation of "erosion").
Implementation of general cellular automata
With k colors and r neighbors on each side, a single step in the evolution of a general cellular automaton is given by
CAStep[CARule[rule_List, k_, r_], a_List] := rule 〚 -1 - ListConvolve[k^Range[0, 2r], a, r + 1] 〛
where rule is obtained from a rule number num by IntegerDigits[num, k, k 2r + 1 ] .
Common framework [for cellular automaton rules]
The Mathematica built-in function CellularAutomaton discussed on page 867 handles general and totalistic rules in the same framework by using ListConvolve[w, a, r + 1] and taking the weights w to be respectively k^Table[i - 1, {i, 2r + 1}] and Table[1, {2r + 1}] .
Implementation [of hexagonal cellular automata]
One can treat hexagonal lattices as distorted square lattices, updated according to
CAStep[rule_List, a_] := Map[rule 〚 14 - # 〛 &, a + 2 ListConvolve[{{1, 1, 0}, {1, 0, 1}, {0, 1, 1}}, a, 2], {2}]
where rule = IntegerDigits[code, 2, 14] .
Implementation [of 2D cellular automata]
An n × n array of white squares with a single black square in the middle can be generated by
PadLeft[{{1}}, {n, n}, 0, Floor[{n, n}/2]]
For the 5-neighbor rules introduced on page 170 each step can be implemented by
CAStep[rule_, a_] := Map[rule 〚 10 - # 〛 &, ListConvolve[{{0, 2, 0}, {2, 1, 2}, {0, 2, 0}}, a, 2], {2}]
where rule is obtained from the code number by IntegerDigits[code, 2, 10] .
For the 9-neighbor rules introduced on page 177
CAStep[rule_, a_] := Map[rule 〚 18 - # 〛 &, ListConvolve[{{2, 2, 2}, {2, 1, 2}, {2, 2, 2}}, a, 2], {2}]
where rule is given by IntegerDigits[code, 2, 18] .
Thus, for example, rule 30 on page 27 corresponds to the list {0, 0, 0, 1, 1, 1, 1, 0} . … In general, the list for a particular rule can be obtained with the function
ElementaryRule[num_Integer] := IntegerDigits[num, 2, 8]
Given a rule together with a list representing the state a of a cellular automaton at a particular step, the following simple function gives the state at the next step:
CAStep[rule_List, a_List] := rule 〚 8 - (RotateLeft[a] + 2 (a + 2 RotateRight[a])) 〛
A list of states corresponding to evolution for t steps can then be obtained with
CAEvolveList[rule_, init_List, t_Integer] := NestList[CAStep[rule, #]&, init, t]
Graphics of this evolution can be generated using
CAGraphics[history_List] := Graphics[ Raster[1 - Reverse[history]], AspectRatio Automatic]
And having set up the definitions above, the Mathematica input
Show[CAGraphics[CAEvolveList[ ElementaryRule[30], CenterList[103], 50]]]
will generate the image:
The description just given should be adequate for most cellular automaton simulations. In some earlier versions of Mathematica a considerably faster version of the program can be created by using the definition
CAStep = Compile[{{rule, _Integer, 1}, {a, _Integer, 1}}, rule 〚 8 - (RotateLeft[a] + 2 (a + 2 RotateRight[a])) 〛 ]
In addition, in Mathematica 4 and above, one can use
CAStep[rule_, a_]:=rule 〚 8 - ListConvolve[{1, 2, 4}, a, 2]]] 〛
or directly in terms of the rule number num
Sign[BitAnd[2^ListConvolve[{1, 2, 4}, a, 2], num]]
(In versions of Mathematica subsequent to the release of this book the built-in CellularAutomaton function can be used, as discussed on page 867 .)
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}, 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 # + } &, {0}, n]]]
(compare page 1005 )
• Position[Map[Split, NestList[Sort[Flatten[{#, # + 1}]] &, {0}, 2 n - 1]], _?
Implementation [of basic aggregation model]
One way to represent a cluster is by giving a list of the coordinates at which each black cell occurs. … With a grid of cells set up in advance, each step in this type of Eden model can be achieved with
AStep[a_] := ReplacePart[a, 1, (# 〚 Random[ Integer, {1, Length[#]}] 〛 &)[Position[(1 - a)Sign[ ListConvolve[{{0, 1, 0}, {1, 0, 1}, {0, 1, 0}}, a, {2, 2}]], 1]]]
This implementation can readily be extended to generalized aggregation models (see below ).
Fractal dimensions [of additive cellular automata]
The total number of nonzero cells in the first t rows of the pattern generated by the evolution of an additive cellular automaton with k colors and weights w (see page 952 ) from a single initial 1 can be found using
g[w_, k_, t_] := Apply[Plus, Sign[NestList[Mod[ ListCorrelate[w, #, {-1, 1}, 0], k] &, {1}, t - 1]], {0, 1}]
The fractal dimension of this pattern is then given by the large m limit of
Log[k,g[w, k,k m + 1 ]/g[w, k, k m ]]
When k is prime it turns out that this can be computed as
d[w_, k_:2] := Log[k,Max[Abs[Eigenvalues[With[ {s = Length[w] - 1}, Map[Function[u, Map[Count[u, #] &, #1]], Map[Flatten[Map[Partition[Take[#, k + s - 1], s, 1] &, NestList[Mod[ListConvolve[w, #], k] &, #, k - 1]], 1] &, Map[Flatten[Map[{Table[0, {k - 1}], #} &, Append[#, 0]]] &, #]]] &[Array[IntegerDigits[#, k, s] &, k s - 1]]]]]]]
For rule 90 one gets d[{1, 0, 1}] = Log[2, 3] ≃ 1.58 .