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 .
1