Search NKS | Online
41 - 50 of 98 for Flatten
![](/common/images/search/spacer.gif)
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. … Given the original list s and the complete prime implicant list p the so-called Quine–McCluskey procedure can be used to find a minimal list of prime implicants, and thus a minimal DNF:
QM[s_, p_] := First[Sort[Map[p 〚 # 〛 &, h[{}, Range[Length[s]], Outer[MatchQ, s, p, 1]]]]]
h[i_, r_, t_] := Flatten[Map[h[Join[i, r 〚 # 〛 ], Drop[r, #], Delete[Drop[t, {}, #], Position[t 〚 All, # 〛 ], {True}]]] &, First[Sort[Position[#, True] &, t]]]], 1]
h[i_, _, {}] := {i}
The number of steps required in this procedure can increase exponentially with the length of p .
Properties [of cyclic tag systems]
Assuming that black and white elements occur in an uncorrelated way, then the sequences in a cyclic tag system with n blocks should grow by an average of Count[Flatten[rules], 1]/n - 1 elements at each step. … Flatten[{1, 0, CTList[{{1, 0, 0, 1}, {0, 1, 1, 0}}, {0, 1}, t]}]
gives for example the Thue–Morse substitution system {1 {1, 0}, 0 {0, 1}} .
Mobile automata [from cellular automata]
Given a mobile automaton with rules in the form used on page 887 , a cellular automaton which emulates it can be constructed using
MAToCA[rules_] := Append[Flatten[Map[g, rules]], {_, _, x_, _, _} x]
g[{a_, b_, c_} {d_, e_}] := {{_, a, b + 2, c, _} d, If[e 1, {a, b + 2, c, _, _} c + 2, {_, _, a, b + 2, c} a + 2]}
This specific definition assumes that the mobile automaton has two possible colors for each cell; it yields a cellular automaton with four possible colors for each cell.
With this setup successive steps in the evolution of the system can be obtained from
GMAStep[rules_, {list_, nlist_}] := Module[{a, na}, {a, na} = Transpose[Map[Replace[Take[list, {# - 1, # + 1}], rules]&, nlist]]; {Fold[ReplacePart[#, Last[#2], First[#2]]&, list, Transpose[{nlist, a}]], Union[Flatten[nlist + na]]}]
Turing machines [from cellular automata]
Given any Turing machine with rules in the form used on page 888 and k possible colors for each cell, a cellular automaton which emulates it can be constructed using
TMToCA[rules_, k_:2] := Flatten[{Map[g[#, k]&, rules], {_, x_, _} x}]
g[{s_, a_} {sp_, ap_, d_}, k_] := {If[d 1, Identity, Reverse][{k s + a, x_, _}] k sp + x, {_, k s + a, _} ap}
If the Turing machine has s states for its head, then the cellular automaton has k (s+1) colors for each cell.
Sequential substitution systems [from cellular automata]
Given a sequential substitution system with rules in the form used on page 893 , the rules for a cellular automaton which emulates it can be obtained from
SSSToCA[rules_] := Flatten[{{v[_, _, _], u, _} u, {_, v[rn_, x_, _], u} r[rn + 1, x], {_, v[_, x_, _], _} x, MapIndexed[ With[{r n = #2 〚 1 〛 , rs = #1 〚 1 〛 , rr = #1 〚 2 〛 }, {If[Length[rs] 1, {u, r[rn, First[rs]], _} q[0, rr], {u, r[rn, First[rs]], _} v[rn, First[rs], Take[rs, 1]]], {u, r[rn, x_], _} v[rn, x, {}], {v[rn, _, Drop[rs, -1]], Last[rs], _} q[Length[rs] - 1, rr], Table[{v[rn, _, Flatten[{___, Take[rs, i - 1]}]], rs 〚 i 〛 , _} v[ rn, rs 〚 i 〛 , Take[rs, i]], {i, Length[rs] - 1, 1, -1}], {v[rn, _, _], y_, _} v[rn, y, {}]}] & , rules /. s List], {_, q[0, {x__, _}], _} q[0, {x}], {_, q[0, {x_}], _} r[1, x], {_, q[0, {}], x_} r[1, x], {_, q[_, {___, x_}], _} x, {_, q[_, {}], x_} x, {_, x_, q[0, _]} x, {_, _, q[n_, {}]} q[n - 1, {}], {_, _, q[n_, {x___, _}]} q[n - 1, {x}], {q[_, {}], _, _} w, {q[0, {__, x_}], p[y_, _], _} p[x, y], {q[0, {__, x_}], y_, _} p[x, y], {p[_, x_], p[y_, _], _} p[x, y], {p[_, x_], u, _} x, {p[_, x_], y_, _} p[x, y], {_, p[x_, _], _} x, {w, u, _} u, {w, x_, _} w, {_, w, x_} x, {_, r[rn_, x_], _} x, {_, u, r[_, _]} u, {_, x_, r[rn_, _]} r[rn, x], {_, x_, _} x}]
The initial condition is obtained by applying the rule s[x_, y__] {r[1, x], y} and then padding with u 's.
MapIndexed[ #1 First[#2] &, Union[Map[# 〚 1, 1 〛 &, #]]] &[ With[{b = Ceiling[Log[2, k]] - 1}, Flatten[Table[ {Table[{Table[{{m, i, n, d}, c} {{m, Mod[i, 2 n - 1 ], n - 1, d}, Quotient[i, 2 n - 1 ], 1}, {n, 2, b}, {i, 0, 2 n - 1}], Table[{ {m, i, 1, d}, c} {{m, -1, 1, d}, i, d}, {i, 0, 1}], Table[ {{m, -1, n, d}, c} {{m, -1, n + 1, d}, c, d}, {n, b - 1}], {{m, -1, b, d}, c} {{0, 0, m}, c, d}}, {d, -1, 1, 2}], Table[{{i, n, m}, c} {{ i + 2 n c, n + 1, m}, c, -1}, {n, 0, b - 1}, {i, 0, 2 n - 1}], With[{r = 2 b }, Table[ If[i + r c ≥ k, {}, Cases[rule, ({m, i + r c} {x_, y_, z_}) {{i, b, m}, c} {{x, Mod[y, r], b, z}, Quotient[y, r], 1})]], {i, 0, r - 1}]]}, {m, s}, {c, 0, 1}]]]]
Some of these states are usually unnecessary, and in the main text such states have been pruned. Given an initial condition {i, list, n} the initial condition for the 2-color Turing machine is
With[{b = Ceiling[Log[2, k]]}, {i, Flatten[IntegerDigits[list, 2, b]], b n}]
Such rule numbers can be converted to general form using
FromDigits[Map[Last, Sort[Flatten[Map[Thread, Thread[{s, IntegerDigits[n, 2, 12]}]], 1]]], 2]
The first one on the bottom (with 63 comparisons) has a nested structure and uses the method invented by Kenneth Batcher in 1964:
Flatten[Reverse[Flatten[With[{m = Ceiling[Log[2, n]] - 1}, Table[With[{d = If[i m, 2 t , 2 i + 1 - 2 t ]}, Map[ {0, d} + # &, Select[Range[n - d], BitAnd[# - 1, 2 t ] If[i m, 0, 2 t ] &]]], {t, 0, m}, {i, t, m}]], 1]], 1]
The second one on the bottom also uses 63 comparisons, while the last one is the smallest known for n = 16 : it uses 60 comparisons and was invented by Milton Green in 1969.
Cyclic tag systems [emulating tag systems]
From a tag system which depends only on its first element, with rules given as in the note below, the following constructs a cyclic tag system emulating it:
TS1ToCT[{n_, subs_}] := With[{k = Length[subs]}, Join[Map[v[Last[#], k] &, subs], Table[{}, {k(n - 1)}]]]
u[i_, k_] := Table[If[j i + 1, 1, 0], {j, k}]
v[list_, k_] := Flatten[Map[u[#, k] &, list]]
The initial condition for the tag system can be converted using v[list, k] .
![](/common/images/search/spacer.gif)