Search NKS | Online
11 - 20 of 41 for ReplaceList
![](/common/images/search/spacer.gif)
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} .
Higher-dimensional generalizations [of substitution systems]
The state of a d -dimensional substitution system can be represented by a nested list of depth d . 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.
Implementation [of 2D Turing machines]
With rules represented as a list of elements of the form {s, a} {sp, ap, {dx, dy}} ( s is the state of the head and a the color of the cell under the head) each step in the evolution of a 2D Turing machine is given by
TM2DStep[rule_, {s_, tape_, r : {x_, y_}}] := Apply[{#1, ReplacePart[tape, #2, {r}], r + #3} &, {s, tape 〚 x, y 〛 } /. rule]
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} //.
Comments on Mathematica functions
CenterList works by first creating a list of n 0's, then replacing the middle 0 by a 1. … CAEvolveList applies CAStep t times. … In general NestList[s[r, #]&, i, 2] ⟶ {i, s[r, i], s[r, s[r, i]]} , etc.
Iterated run-length encoding
Starting say with {1} consider repeatedly replacing list by (see page 1070 )
Flatten[Map[{Length[#], First[#]} &, Split[list]]]
The resulting sequences contain only the numbers 1, 2 and 3, but otherwise at first appear fairly random.
Substitution systems in which all replacements are done that are found to fit in a left-to-right scan can be implemented as follows
GSSEvolveList[rule_, s_, n_] := NestList[GSSStep[rule, #] &, s, n]
GSSStep[rule_, s_] := g[rule, s, f[StringPosition[s, Map[First, rule]]]]
f[{ }] = { }; f[s_] := Fold[If[Last[Last[#1]] ≥ First[#2], #1, Append[#1, #2]]&, {First[s]}, Rest[s]]
g[rule_, s_, { }] := s; g[rule_, s_, pos_] := StringReplacePart[ s, Map[StringTake[s, #] &, pos] /. rule, pos]
with rules given as {"ABA" "BAAB", "BBBB" "AA"} .
And with this setup, t steps of evolution can be found with
SSSEvolveList[rule_, init_s, t_Integer] := NestList[(# /. rule)&, init, t]
Note that as an alternative to having s be Flat , one can explicitly set up rules based on patterns such as s[x___, 1, 0, y___] s[x, 0, 1, 0, y] . And by using rules such as s[x___, 1, 0, y___] {s[x, 0, 1, 0, y], Length[s[x]]} one can keep track of the positions at which substitutions are made. ( StringReplace replaces all occurrences of a given substring, not just the first one, so cannot be used directly as an alternative to having a flat function.)
For 1D elementary rules the list is {{-1}, {0}, {1}} , while for 2D 5-neighbor rules it is {{-1, 0}, {0, -1}, {0, 0}, {0, 1}, {1, 0}} . … One can specify a neighborhood configuration by giving in the same order as the offset list the color of each cell in the neighborhood. … A single step in evolution of a general cellular automaton with state a and rule number num is then given by
Map[IntegerDigits[num, k, k^Length[os]] 〚 -1 - # 〛 &, Apply[Plus, MapIndexed[k^(Length[os] - First[#2]) RotateLeft[a, #1] &, os]], {-1}]
or equivalently by
Map[IntegerDigits[num, k, k^Length[os]] 〚 -# - 1 〛 &, ListCorrelate[Fold[ReplacePart[k #1, 1, #2 + r + 1] &, Array[0 &, Table[2r + 1, {d}]], os], a, r + 1], {d}]
With this setup, a network consisting of just one node is {{1, 1}} and a 1D array of n nodes can be obtained with
CyclicNet[n_] := RotateRight[ Table[Mod[{i - 1, i + 1}, n] + 1, {i, n}]]
With above connections represented as 1 and the below connections as 2 , the node reached by following a succession s of connections from node i is given by
Follow[list_, i_, s_List] := Fold[list 〚 #1 〛 〚 #2 〛 &, i, s]
The total number of distinct nodes reached by following all possible succession of connections up to length d is given by
NeighborNumbers[list_, i_Integer, d_Integer] := Map[Length, NestList[Union[Flatten[list 〚 # 〛 ]] &, Union[list 〚 i 〛 ], d - 1]]
For each such list the rules for the network system then specify how the connections from node i should be rerouted. The rule {2, 3} {{2, 1}, {1}} specifies that when NeighborNumbers gives {2, 3} for a node i , the connections from that node should become {Follow[list, i, {2, 1}], Follow[list, i, {1}]} . … With rules set up in this way, each step in the evolution of a network system is given by
NetEvolveStep[{depth_Integer, rule_List}, list_List] := Block[ {new = {}}, Join[Table[Map[NetEvolveStep1[#, list, i] &, Replace[NeighborNumbers[list, i, depth], rule]], {i, Length[list]}], new]]
NetEvolveStep1[s : {___Integer}, list_, i_] := Follow[list, i, s]
NetEvolveStep1[{s1 : {___Integer}, s2 : {___Integer}}, list_, i_] := Length[list] + Length[ AppendTo[new, {Follow[list, i, s1], Follow[list, i, s2]}]]
The set of nodes that can be reached from node i is given by
ConnectedNodes[list_, i_] := FixedPoint[Union[Flatten[{#, list 〚 # 〛 }]] &, {i}]
and disconnected nodes can be removed using
RenumberNodes[list_, seq_] := Map[Position[seq, #] 〚 1, 1 〛 &, list 〚 seq 〛 , {2}]
The sequence of networks obtained on successive steps by applying the rules and then removing all nodes not connected to node number 1 is given by
NetEvolveList[rule_, init_, t_Integer] := NestList[(RenumberNodes[#, ConnectedNodes[#, 1]] &)[ NetEvolveStep[rule, #]] &, init, t]
Note that the nodes in each network are not necessarily numbered in the order that they appear on successive lines in the pictures in the main text.
![](/common/images/search/spacer.gif)