Search NKS | Online
71 - 80 of 121 for Table
![](/common/images/search/spacer.gif)
Given a sequence of length n , an approximation to h can be reconstructed using
Max[MapIndexed[#1/First[#2] &, FoldList[Plus, First[list], Rest[list]]]]
The fractional part of the result obtained is always an element of the Farey sequence
Union[Flatten[Table[a/b, {b, n}, {a, 0, b}]]]
(See also pages 892 , 932 and 1084 .)
The third curve shown on page 346 is obtained from
Table[Cost[IntegerDigits[i, 2, n]], {i, 0, 2 n - 1}]
There is no single ordering that makes all states which can be reached by changing a single square be adjacent.
The table below gives results obtained with a few specific rules.
Implementation [of TM cellular automaton]
Given a non-deterministic Turing machine with rules in the form above, the rules for a cellular automaton which emulates it can be obtained from
NDTMToCA[tm_] := Flatten[{{_, h, _} h, {s, _c, _} e, {s, _, _} s, {_, s, c[i_]} s[i], {_, s, x_} x, {a[_, _], _s, _} s, {_, a[x_, y_], s[i_]} a[x, y, i], {x_, _s, _} x, {_, _, s[i_]} s[i], Map[Table[With[{b = (# 〚 Min[Length[#], z] 〛 &)[ {x, #} /. tm]}, If[Last[b] -1, {{a[_], a[x, #, z], e} h, {a[ _], a[x, #, z], s} a[x, #, z], {a[_], a[x, #, z], _} a[b 〚 2 〛 ], {a[x, #, z], a[w_], _} a[b 〚 1 〛 , w], {_, a[w_], a[x, #, z]} a[w]}, {{a[_], a[x, #, z], _} a[b 〚 2 〛 ], {a[x, #, z], a[w_], _} a[w], {_, a[w_], a[x, #, z]} a[b 〚 1 〛 , w]}]], {x, Max[Map[# 〚 1, 1 〛 &, tm]]}, {z, Max[Map[Length[# 〚 2 〛 ] &, tm]]}] &, Union[Map[# 〚 1, 2 〛 &, tm]]], {_, x_, _} x}]
But if one also allows higher mathematical functions then it turns out that such a formula can in fact be found: as indicated in the table above each coefficient is given by a particular value of a so-called Gegenbauer or ultraspherical function.
At step n , the complete array of cells is
Table[If[FreeQ[Transpose[IntegerDigits[{i, j}, k, n]], form], 1, 0], {i, 0, k n - 1}, {j, 0, k n - 1}]
where for the pattern on page 187 , k = 2 and form = {0, 1} .
And as the table below illustrates, the entries in Pascal's triangle are simply the binomial coefficients that appear when one expands out the powers of 1 + x .
Mobile automata [emulating cellular automata]
Given the rules for an elementary cellular automaton in the form used on page 867 , the following will construct a mobile automaton which emulates it:
vals = {x, p[0], q[0, 0], q[0, 1], q[1, 0], q[1, 1], p[1]}
CAToMA[rules_] := Table[(# Replace[#, {{q[a_, b_], p[c_], p[d_]} {q[c, {a, c, d} /. rules], 1}, {q[a_, b_], p[c_], x} {q[c, {a, c, 0} /. rules], 1}, {q[_, _], x, x} {p[0], -1}, {q[_, _], q[_, a_], p[_]} {p[a], -1}, {x, q[_, a_], p[_]} {p[a], -1}, {x, x, p[_]} {q[0, 0], 1}, {_, _, _} {x, 0}}]) &[vals 〚 IntegerDigits[i, 7, 3] + 1 〛 ], {i, 0, 7 3 - 1}]
The ordering in vals defines a mapping of symbolic cell values onto colors.
DNF minimization
From a table of values for a Boolean function one can immediately get a DNF representation just by listing cases where the value is 1. … Given an original DNF list s , this can be done using PI[s, n] :
PI[s_, n_] := Union[Flatten[ FixedPointList[f[Last[#], n] &, {{}, s}] 〚 All, 1 〛 , 1]]
g[a_, b_] := With[{i = Position[Transpose[{a, b}], {0,1}]}, If[Length[i] 1 && Delete[a, i] === Delete[b, i], {ReplacePart[a, _, i]}, {}]]
f[s_, n_] := With[ {w = Flatten[Apply[Outer[g, #1, #2, 1] &, Partition[Table[ Select[s, Count[#, 1] i &], {i, 0, n}], 2, 1], {1}], 3]}, {Complement[s, w, SameTest MatchQ], w}]
The minimal DNF then consists of a collection of these prime implicants.
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. … 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)