Search NKS | Online
11 - 20 of 98 for Flatten
The evolution of the system for t steps can be obtained from
SSEvolve[rule_, init_, t_, d_Integer] := Nest[FlattenArray[# /. rule, d] &, init, t]
FlattenArray[list_, d_] := Fold[Function[{a, n}, Map[MapThread[Join, #, n] &, a, -{d + 2}]], list, Reverse[Range[d] - 1]]
The analog in 3D of the 2D rule on page 187 is
{1 Array[If[LessEqual[##], 0, 1] &, {2, 2, 2}], 0 Array[0 &, {2, 2, 2}]}
Note that in d dimensions, each black cell must be replaced by at least d + 1 black cells at each step in order to obtain an object that is not restricted to a dimension d - 1 hyperplane.
Polish representation (whose reverse form has been used in HP calculators) for an expression can be obtained using (see also page 1173 )
Flatten[expr //. x_[y_] { ∘ , x, y}]
The original expression can be recovered using
First[Reverse[list] //. … If only a single symbol ever appears, then all that matters is the overall structure of an expression, which can be captured as in the main text by the sequence of opening and closing brackets, given by
Flatten[Characters[ToString[expr]]/.{"[" 1,"]" 0, " ℯ " {}}]
One-element-dependence tag systems [emulating TMs]
Writing the rule {3, {{0, _, _} {0, 0}, {1, _, _} {1, 1, 0, 1}}} from page 895 as {3, {0 {0, 0}, 1 {1, 1, 0, 1}}} the evolution of a tag system that depends only on its first element is obtained from
TS1EvolveList[rule_, init_, t_] := NestList[TS1Step[rule, #] &, init, t]
TS1Step[{n_, subs_}, {}] = {}
TS1Step[{n_, subs_}, list_] := Drop[Join[list, First[list] /. subs], n]
Given a Turing machine in the form used on page 888 the following will construct a tag system that emulates it:
TMToTS1[rules_] := {2, Union[Flatten[rules /. ({i_, u_} {j_, v_, r_}) {Map[#[i] {#[i, 1], #[i, 0]} &, {a, b, c, d}], If[r 1, {a[i, u] {a[j], a[j]}, b[i, u] Table[b[j], {4}], c[i, u] Flatten[{Table[b[j], {2v}], Table[c[j], {2 - u}]}], d[i, u] {d[j]}}, {a[i, u] Table[a[j], {2 - u}], b[i, u] {b[j]}, c[i, u] Flatten[{c[j], c[j], Table[d[j], {2v}]}], d[i, u] Table[d[j], {4}]}]}]]}
A Turing machine in state i with a blank tape corresponds to initial condition {a[i], a[i], c[i]} for the tag system.
{ds[r_, s_] d[r, adrs 〚 s 〛 ], dr[r_, j_] d[r, j + First[#2]]} &, Flatten[segs]]]
seg[i[r_], {a_}] := With[{p = Prime[r]}, Flatten[{Table[i[2], {p}], dr[1, -p], i[1], dr[2, -1], Table[dr[1, 1], {p + 1}]}]]
seg[d[r_, n_], {a_}] := With[{p = Prime[r]}, Flatten[{i[2], dr[ 1, 5], i[1], dr[2, -1], dr[1, 1], ds[1, n], Table[{If[m p - 1, ds[1, a], dr[1, 3p + 2 - m]], Table[i[1], {p}], dr[2, -p], Table[dr[1, 1], {2p - m - 1}], ds[1, a + 1]}, {m, p - 1}]}]]
The initial conditions for the 2-register machine are given by {1, {RMEncode[list], 0}} and the results corresponding to each step in the evolution of the multiregister machine appear whenever register 2 in the 2-register machine is incremented from 0.
With this setup, each step then corresponds to
LifeStep[list_] := With[{p=Flatten[Array[List, {3, 3}, -1], 1]}, With[{u = Split[Sort[Flatten[Outer[Plus, list, p, 1], 1]]]}, Union[Cases[u, {x_, _, _} x], Intersection[Cases[u, {x_, _, _, _} x], list]]]]
(A still more efficient implementation is based on finding runs of length 3 and 4 in Sort[u] .)
Huffman coding
From a list p of probabilities for blocks, the list of codewords can be generated using
Map[Drop[Last[#], -1] &, Sort[ Flatten[MapIndexed[Rule, FixedPoint[Replace[Sort[#], {{p0_, i0_}, {p1_, i1_}, pi___} {{p0 + p1, {i0, i1}}, pi}] & , MapIndexed[List, p]] 〚 1, 2 〛 , {-1}]]]] -1
Given the list of codewords c , the sequence of blocks that occur in encoded data d can be uniquely reconstructed using
First[{{}, d} //. MapIndexed[ {{r___}, Flatten[{#1, s___}]} {{r,#2 〚 1 〛 },{s}} &, c]]
Note that the encoded data can consist of any sequence of 0's and 1's.
And with this representation, the evolution for t steps is given by
SSEvolveList[rule_, init_List, t_Integer] := NestList[Flatten[# /. rule]&, init, t]
where in the first example on page 82 , the initial condition is {1} .
… In this case, the evolution can be obtained using
SSEvolveList[rule_, init_String, t_Integer] := NestList[StringReplace[#, rule]&, init, t]
For a neighbor-dependent substitution system such as the first one on page 85 the rule can be given as
{{1, 1} {0, 1}, {1, 0} {1, 0}, {0, 1} {0}, {0, 0} {0, 1}}
And with this representation, the evolution for t steps is given by
SS2EvolveList[rule_, init_List, t_Integer] := NestList[Flatten[Partition[#, 2, 1] /. rule]&, init, t]
where the initial condition for the first example on page 85 is {0, 1, 1, 0} .
Given a list of 0 and 1 values for successive memory locations, the right-hand initial conditions are Flatten[list /. {1 {8, 1}, 0 {4, 1}}] . To access location n the left-hand initial conditions must contain Flatten[{0, i, IntegerDigits[n, 2] /. {1 {0, 11}, 0 {0, 2}}}] inserted in a repetitive {0, 1} background.
Starting with a list of nodes, the nodes reached by following arcs with value a for one step are given by
NetStep[net_, i_, a_] := Union[ReplaceList[a, Flatten[net 〚 i 〛 ]]]
A list of values then corresponds to a path in the network starting from any node if
Fold[NetStep[net, #1, #2]&, Range[Length[net]], list] =!= {}
Given a set of sequences of values represented by a particular network, the set obtained after one step of cellular automaton evolution is given by
NetCAStep[{k_, r_, rtab_}, net_] := Flatten[ Map[Table[# /. … To obtain such trimmed networks one can apply the function
TrimNet[net_] := With[{m = Apply[Intersection, Map[FixedPoint[ Union[#, Flatten[Map[Last, net 〚 # 〛 , {2}]]]&, #]&, Map[List, Range[Length[net]]]]]}, net 〚 m 〛 /.
Given a list of blocks such as {{1, 1}, {0}} each element of Flatten[list] can be thought of as a state in a finite automaton or a Markov process (see page 1084 ). The transitions between these states have probabilities given by m[Map[Length, list]] where
m[s_] := With[{q = FoldList[Plus, 0, s]}, ReplacePart[ RotateRight[IdentityMatrix[Last[q]], {0, 1}], 1/Length[s], Flatten[Outer[List, Rest[q], Drop[q, -1] + 1], 1]]]
The average spectrum of sequences generated according to these probabilities can be obtained by computing the correlation function for elements a distance r apart
ξ [list_, r_] := With[{w = (# - Apply[Plus, #]/Length[#] &)[ Flatten[list]]}, w .