Search NKS | Online
31 - 40 of 160 for Map
Implementation [of finite automata for nested patterns]
Given the rules for a substitution system in the form used on page 931 a finite automaton (as on page 957 ) which yields the color of each cell from the digit sequences of its position is
Map[Flatten[MapIndexed[#2 - 1 Position[rules, #1 _] 〚 1, 1 〛 &, Last[#], {-1}]] &, rules]
This works in any number of dimensions so long as each replacement yields a block of the same cuboidal form.
Ulam systems
Having formulated the system around 1960, Stanislaw Ulam and collaborators (see page 877 ) in 1967 simulated 120 steps of the process shown below, with black cells after t steps occurring at positions
Map[First, First[Nest[UStep[p[q[r[#1], #2]] &, {{1, 0}, {0, 1}, {-1, 0}, {0, -1}}, #] &, ({#, #} &)[{{{0, 0}, {0, 0}}}], t]]]
UStep[f_, os_, {a_, b_}] := {Join[a, #], #} &[f[Flatten[ Outer[{#1 + #2, #1} &, Map[First, b], os, 1], 1], a]]
r[c_]:= Map[First, Select[Split[Sort[c], First[#1] First[#2] &], Length[#] 1 &]]
q[c_, a_] := Select[c, Apply[And, Map[Function[u, qq[#1, u, a]], a]] &]
p[c_]:= Select[c, Apply[And, Map[Function[u, pp[#1, u]], c]] &]
pp[{x_, u_}, {y_, v_}] := Max[Abs[x - y]] > 1 || u v
qq[{x_, u_}, {y_, v_}, a_] := x y || Max[Abs[x - y]] > 1 || u y || First[Cases[a, {u, z_} z]] y
These rules are fairly complicated, and involve more history than ordinary cellular automata.
Recursive subdivision [encoding]
In one dimension, encoding can be done using
Subdivide[a_] := Flatten[ If[Length[a] 2, a, If[Apply[SameQ, a], {1,First[a]}, {0, Map[Subdivide, Partition[a, Length[a]/2]]}]]]
In n dimensions, it can be done using
Subdivide[a_, n_] := With[{s = Table[1, {n}]}, Flatten[ If[Dimensions[a] 2s, a, If[Apply[SameQ, Flatten[a]], {1, First[Flatten[a]]}, {0, Map[Subdivide[#, n] &, Partition[a, 1/2Length[a] s], {n}]}]]]]
Implementation [of 2D substitution systems]
With the rule on page 187 given for example by {1 {{1, 0}, {1, 1}}, 0 {{0, 0}, {0, 0}}} the result of t steps in the evolution of a 2D substitution system from a initial condition such as {{1}} is given by
SS2DEvolve[rule_, init_, t_] := Nest[Flatten2D[# /. rule] &, init, t]
Flatten2D[list_] := Apply[Join, Map[MapThread[Join, #] &, list]]
Implementation [of patterning model]
Given a 2D array of values a and a list of weights w , each step in the evolution of the system corresponds to
WeightedStep[w_List, a_] := Map[If[# > 0, 1, 0]&, Sum[w 〚 1 + i 〛 Apply[Plus, Map[RotateLeft[a, #]&, Layer[i]]], {i, 0, Length[w] - 1}], {2}]
Layer[n_] := Layer[n] = Select[Flatten[Table[{i, j}, {i, -n, n}, {j, -n, n}],1], MemberQ[#, n| - n]&]
Note (a) for Iterated Maps and the Chaos Phenomenon
Most often considered, notably by Kunihiko Kaneko and co-workers, were so-called "coupled map lattices" or "lattice dynamical systems" in which an iterated map (typically a logistic map) was applied at each step to a combination of neighboring cell value.
Just as in iterated maps, a small change in the initial values a[0] etc. can often lead to an exponentially increasing difference in later values of a[t] , etc. But as in iterated maps, the main part of this process that has been analyzed is simply the excavation of progressively less significant digits in the number a[0] .
(Note that numerical simulations of ODEs on computers must approximate continuous time by discrete steps, making the system essentially an iterated map, and often yielding spurious complicated behavior.)
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. … 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]]]
Sarkovskii's theorem
For any iterated map based on a continuous function such as a polynomial it was shown in 1962 that if an initial condition exists that gives period 3, then other initial conditions must exist that give any other period. In general, if a period m is possible then so must all periods n for which p = {m, n} satisfies
OrderedQ[Transpose[If[MemberQ[p/#, 1], Map[Reverse, {p/#, #}], {#, p/#}]] &[2^IntegerExponent[p, 2]]]
Extensions of this to other types of systems seem difficult to find, but it is conceivable that when viewed as continuous mappings on a Cantor set (see page 869 ) at least some cellular automata might exhibit similar properties.