Search NKS | Online

{x, y}, 1] where m is a matrix such as {{2, 1}, {1, 1}} . … But as soon as m itself contains rational numbers, complicated behavior can be obtained even with an initial condition such as {1, 1} .
Checking [tilings with] constraints A set of allowed templates can be specified by a Mathematica pattern of the form t 1 | t 2 | t 3 etc. where the t i are for example {{_, 1, _}, {0, 0, 1}, {_, 0, _}} . To check whether an array list contains only arrangements of colors corresponding to allowed templates one can then use SatisfiedQ[list_, allowed_] := Apply[And, Map[MatchQ[#, allowed] &, Partition[list, {3, 3}, {1, 1}], {2}], {0, 1}]
Discrete Voronoi diagrams The k = 3 , r = 1 cellular automaton {{0 | 1, n : (0 | 1), 0 | 1}  n, {_, 0, _}  2, {_, n_, _}  n - 1} is an example of a system that generates discrete 1D Voronoi diagrams by having regions that grow from every initial black cell, but stop whenever they meet, as shown below.
Starting with an ordinary base 2 digit sequence, one prepends a unary specification of its length, then a specification of that length specification, and so on: (Flatten[{Sign[-Range[1 - Length[#], 0]], #}] &)[ Map[Rest, IntegerDigits[Rest[Reverse[NestWhileList[ Floor[Log[2, #] &, n + 1, # > 1 &]]],2]]] (d) Binary-coded base 3. … Flatten[IntegerDigits[ Append[2 - With[{w = Floor[Log[3, 2n]]}, IntegerDigits[n - (3 w + 1 - 1)/2, 3, w]], 3], 2, 2]] (e) Fibonacci encoding. … Apply[Take, RealDigits[(N[#, N[Log[10, #] + 3]] &)[ n √ 5 /GoldenRatio 2 + 1/2], GoldenRatio]] The representations of all the first Fibonacci[n] - 1 numbers can be obtained from (the version in the main text has Rest[RotateLeft[Join[#, {0, 1}]]] & applied) Apply[Join, Map[Last, NestList[{# 〚 2 〛 ], Join[Map[Join[{1, 0}, Rest[#]] & , # 〚 2 〛 ], Map[Join[{1, 0}, #] &, # 〚 1 〛 ]]} &, {{}, {{1}}}, n-3]]]
MemberQ[c, #], Append[c, #], AStep[c]]& [f[c] + f[{{1, 0}, {0, 1}, {-1, 0}, {0, -1}}]] f[a_]:=a 〚 Random[Integer, {1, Length[a]}] 〛 This implementation can easily be extended to any type of lattice and any number of dimensions. … 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 ).
For rule 90 the combination c can be specified as {{1, 0, 1}} , while for rule 150R it can be specified as {{0, 1, 0}, {1, 1, 1}} . … Starting with a list of the initial conditions for s steps, the configurations for the next s steps are given by Append[Rest[list], Map[Mod[Apply[Plus, Flatten[c #]], 2]&, Transpose[ Table[RotateLeft[list, {0, i}], {i, -r, r}], {3, 2, 1}]]] where r = (Length[First[c]] - 1)/2 . … Solve[z 2  h z + 1] and h = 1/x + 1 + x .
TMToRM[rules_] := Module[{segs, adrs}, segs = Map[TMCompile, rules] ; adrs = Thread[Map[First, rules]  Drop[FoldList[Plus, 1, Map[Length, segs]], -1]]; MapIndexed[(# /. {dr[r_, n_]  d[r, n + First[#2]], dm[r_, z_]  d[r, z /. adrs]})&, Flatten[segs]]] TMCompile[_  z:{_, _, 1}] := f[z, {1, 2}] TMCompile[_  z:{_, _, -1}] := f[z, {2, 1}] f[{s_, a_, _}, {ra_, rb_}] := Flatten[{i[3], dr[ra, -1], dr[3, 3], i[ra], i[ra], dr[3, -2], If[a  1, i[ra], {}], i[3], dr[rb, 5], i[rb], dr[3, -1], dr[rb, 1], dm[rb, {s, 0}], dr[rb, -6], i[rb], dr[3, -1], dr[rb, 1], dm[rb, {s, 1}]}] A blank initial tape for the Turing machine corresponds to initial conditions {1, {0, 0, 0}} for the register machine. … Given the list of successive configurations of the register machine, the steps that correspond to successive steps of Turing machine evolution can be obtained from (Flatten[Partition[Complement[#, #-1], 1, 2]]&)[ Position[list, {_,{_,_,0}}]] The program given above works for Turing machines with any number of states, but it requires some simple extensions to handle more than two possible colors for each cell.
With k colors each giving a string of the same length s the recurrence relation is Thread[Map[ ϕ [#][t + 1, ω ] &, Range[k] - 1]  Apply[Plus, MapIndexed[Exp[  ω (Last[#2] - 1) s t ] ϕ [#1][t, ω ] &, Range[k] - 1 /. rules, {-1}], {1}]/ √ s ] Some specific properties of the examples shown include: (a) (Thue–Morse sequence) The spectrum is essentially Nest[Range[2 Length[#]] Join[#, Reverse[#]] &, {1}, t] . … The generating function for the sequence (with 0 replaced by -1) satisfies f[z]  (1 - z) f[z 2 ] , so that f[z]  Product[1 - z 2 n , {n, 0, ∞ }] . … (d) (Period-doubling sequence) The spectrum is (2 # - (-1) # &)[1 + IntegerExponent[n, 2]] , almost like the markings on a base 2 ruler.
[Generating sequences with] unequal probabilities Given a sequence a of n equally probable 0's and 1's, the following generates a single 0 or 1 with probabilities approximating {1 - p, p} to n digits: Fold[({BitAnd, BitOr} 〚 1 + First[#2] 〛 [#1, Last[#2]]) &, 0, Reverse[Transpose[{First[RealDigits[p, 2, n, -1]], a}]]] This can be generalized to allow a whole sequence to be generated with as little as an average of two input digits being used for each output digit.
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}] .
1 ... 10111213 ...