Search NKS | Online
11 - 20 of 32 for RotateLeft
More colors [in additive cellular automata]
The pictures below show generalizations of rule 90 to k possible colors using the rule
CAStep[k_Integer, a_List] := Mod[RotateLeft[a] + RotateRight[a], k]
or equivalently Mod[ListCorrelate[{1, 0, 1}, a, 2], k] .
Cyclic tag systems which allow any value for each element can be obtained by adding the rule
CTStep[{{r_, s___}, {n_, a___}}] := {{s, r}, Flatten[{a, Table[r, {n}]}]}
The leading elements in this case can be obtained using
CTListStep[{rules_, list_}] := {RotateLeft[rules, Length[list]], With[{n = Length[rules]}, Flatten[Apply[Table[#1, {#2}] &, Map[Transpose[ {rules, #}] &, Partition[list, n, n, 1, 0]], {2}]]]}
Block cellular automata
With a rule of the form {{1, 1} {1, 1}, {1, 0} {1, 0}, {0, 1} {0, 0}, {0, 0} {0, 1}} the evolution of a block cellular automaton with blocks of size n can be implemented using
BCAEvolveList[{n_Integer, rule_}, init_, t_] := FoldList[BCAStep[{n, rule}, #1, #2]&, init, Range[t]] /; Mod[Length[init], n] 0
BCAStep[{n_, rule_}, a_, d_] := RotateRight[ Flatten[Partition[RotateLeft[a, d], n]/.rule], d]
Starting with a single black cell, none of the k = 2 , n = 2 block cellular automata generate anything beyond simple nested patterns.
Implementation [of cyclic tag systems]
With the rules for the cyclic tag system on page 95 given as {{1, 1}, {1, 0}} , the evolution can be obtained from
CTEvolveList[rules_, init_, t_] := Map[Last, NestList[CTStep, {rules, init}, t]]
CTStep[{{r_, s___}, {0, a___}}] := {{s, r}, {a}}
CTStep[{{r_, s___}, {1, a___}}] := {{s, r}, Join[{a}, r]}
CTStep[{u_, {}}] := {u, {}}
The leading elements on many more than t successive steps can be obtained directly from
CTList[rules_, init_, t_] := Flatten[Map[Last, NestList[CTListStep, {rules, init}, t]]]
CTListStep[{rules_, list_}] := {RotateLeft[rules, Length[list]],Flatten[rules 〚 Mod[Flatten[Position[list, 1]], Length[rules], 1] 〛 ]}
Implementation [of constraint satisfaction]
The number of squares violating the constraint used here is given by
Cost[list_] := Apply[Plus, Abs[list - RotateLeft[list]]]
When applied to all possible patterns, this function yields a distribution with Gaussian tails, but with a sharp point in the middle.
With rule given by IntegerDigits[num, k, k 2 ] a single step of evolution can be implemented as
CAStep[{k_, rule_}, a_List] := rule 〚 k 2 - RotateLeft[a] - k a 〛
The solution is Fold[Mod[#1 + k, #2, 1]&, 0, Range[n]] , or FromDigits[RotateLeft[IntegerDigits[n, 2]], 2] for k = 2 .
For equations of the form
∂ tt u[t, x] ∂ xx u[t, x] + f[u[t, x]]
one can set up a simple finite difference method by taking f in the form of pure function and creating from it a kernel with space step dx and time step dt :
PDEKernel[f_, {dx_, dt_}] := Compile[{a,b,c,d}, Evaluate[(2 b - d) + ((a + c - 2 b)/dx 2 + f[b]) dt 2 ]]
Iteration for n steps is then performed by
PDEEvolveList[ker_, {u0_, u1_}, n_] := Map[First, NestList[PDEStep[ker, #]&, {u0, u1}, n]]
PDEStep[ker_, {u1_, u2_}] := {u2, Apply[ker, Transpose[ {RotateLeft[u2], u2, RotateRight[u2], u1}], {1}]}
With this approach an approximation to the top example on page 165 can be obtained from
PDEEvolveList[PDEKernel[ (1 - # 2 )(1 + #)&, {.1, .05}], Transpose[ Table[{1, 1} N[Exp[-x 2 ]], {x, -20, 20, .1}]], 400]
For both this example and the middle one the results converge rapidly as dx decreases.
The regularity of PN sequences is revealed by looking at the autocorrelation RotateLeft[(-1) list , m] . (-1) list .
Each step in its evolution can be implemented using
LifeStep[a_List] := MapThread[If[(#1 1 && #2 4) || #2 3, 1, 0]&, {a, Sum[RotateLeft[a, {i, j}], {i, -1, 1}, {j, -1, 1}]}, 2]
A more efficient implementation can be obtained by operating not on a complete array of black and white cells but rather just on a list of positions of black cells.