Search NKS | Online
1 - 10 of 210 for Listable
And indeed if one starts from the beginning of the list one finds that most of the theorems can readily be derived from simpler ones earlier in the list. … Theorems which cannot be derived from ones earlier in the list are highlighted. The last highlighted theorem is 539th in the list.
One way to do this is by using the Gödel number Product[Prime[i]^list 〚 i 〛 , {i, Length[list]}] . … Given p = Array[Prime, Length[list], PrimePi[Max[list]] + 1] or any list of integers that are all relatively prime and above Max[list] (the integers in list are assumed positive)
CRT[list_, p_] := With[{m = Apply[Times, p]}, Mod[Apply[Plus, MapThread[#1 (m/#2)^EulerPhi[#2] &, {list, p}]], m]]
yields a number x such that Mod[x, p] list . Based on this
LE[list_] := Module[{n = Length[list], i = Max[MapIndexed[ #1 - #2 &, PrimePi[list]]] + 1}, CRT[PadRight[ list, n + i], Join[Array[Prime[i + #] &, n], Array[Prime, i]]]]
will yield a number x that can be decoded into a list of length n using essentially the so-called Gödel β function
Mod[x, Prime[Rest[NestList[NestWhile[# + 1 &, # + 1, Mod[x, Prime[#]] 0 &] &, 0, n]]]]
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.
Extended instruction sets [for register machines]
One can consider also including instructions such as
RMExecute[eq[r1_, r2_, m_], {n_, list_}] := If[list 〚 r1 〛 list 〚 r2 〛 , {m, list}, {n + 1, list}]
RMExecute[add[r1_, r2_], {n_, list_}] := {n + 1, ReplacePart[list, list 〚 r1 〛 + list 〚 r2 〛 , r1]}
RMExecute[jmp[r1_], {n_, list_}] := {list 〚 r1 〛 , list}
Note that by being able to add and subtract only 1 at each step, the register machines shown in the main text necessarily operate quite slowly: they always take at least n steps to build up a number of size n .
Implementation [of register machines]
The state of a register machine at a particular step can be represented by the pair {n, list} , where n gives the position in the program of current instruction being executed (the "program counter") and list gives the values of the registers. … With this setup, the evolution of any register machine can be implemented using the functions (a typical initial condition is {1, {0, 0}} )
RMStep[prog_, {n_Integer, list_List}] := If[n > Length[prog], {n, list}, RMExecute[prog 〚 n 〛 , {n, list}]]
RMExecute[i[r_], {n_, list_}] := {n + 1, MapAt[(# + 1)&, list, r]}
RMExecute[d[r_, m_], {n_, list_}] := If[list 〚 r 〛 > 0, {m, MapAt[(# - 1)&, list, r]}, {n + 1, list}]
RMEvolveList[prog_, init:{_Integer, _List}, t_Integer] := NestList[RMStep[prog, #]&, init, t]
The total number of possible programs of length n using k registers is (k (1 + n)) n .
Given only an output list NestList[Mod[a #, m]&, x, n] parameters {a, m} that generate the list can be found for sufficiently large n from
With[{ α = Apply[(#2 . Rest[list]/#1) &, Apply[ ExtendedGCD, Drop[list, -1]]]}, {Mod[ α , #], #} &[ Fold[GCD[#1, If[#1 0, #2, Mod[#2, #1]]] &, 0, ListCorrelate[{ α , -1}, list]]]]
With slightly more effort both x and {a, m} can be found just from First[IntegerDigits[list, 2, p]] .
Second-order cellular automata
Second-order elementary rules can be implemented using
CA2EvolveList[rule_List, {a_List, b_List}, t_Integer] := Map[First, NestList[CA2Step[rule, #]&, {a, b}, t]]
CA2Step[rule_List, {a_, b_}] := {b, Mod[a + rule 〚 8 - (RotateLeft[b] + 2 (b + 2 RotateRight[b])) 〛 , 2]}
where rule is obtained from the rule number using IntegerDigits[n, 2, 8] .
The combination Drop[list, -1] + 2 Drop[list, 1] of the result from CA2EvolveList corresponds to evolution according to a first-order k = 4 , r = 1 rule.
Spectra [of sequences]
The spectra shown are given by Abs[Fourier[data]] , where the symmetrical second half of this list is dropped in the pictures. … These are related to the autocorrelation function according to
Fourier[list] 2 Fourier[ListConvolve[list, list, {1, 1}]]/Sqrt[Length[list]]
(See also page 1074 .)
Implementation [of continuous cellular automata]
The state of a continuous cellular automaton at a particular step can be represented by a list of numbers, each lying between 0 and 1. This list can then be updated using
CCAEvolveStep[f_, list_List] := Map[f, (RotateLeft[list] + list + RotateRight[list])/3]
CCAEvolveList[f_, init_List, t_Integer] := NestList[CCAEvolveStep[f, #] &, init, t]
where for the rule on page 157 f is FractionalPart[3#/2] & while for the rule on page 158 it is FractionalPart[# + 1/4] & .
Note that in the definitions above, the elements of list can be either exact rational numbers, or approximate numbers obtained using N .
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] 〛 ]}