Search NKS | Online
61 - 70 of 160 for Map
This yields a chord such as
Play[Evaluate[Apply[Plus, Flatten[Map[Sin[1000 # t] &, N[2 1/12 ]^Position[list, 1]]]]], {t, 0, 0.2}]
A sequence of such chords can sometimes provide a useful representation of cellular automaton evolution.
Numbering scheme [for Turing machines]
One can number Turing machines and get their rules using
Flatten[MapIndexed[{1, -1} #2 + {0, k} {1, 1, 2} Mod[Quotient[#1, {2k, 2, 1}], {s, k, 2}] + {1, 0, -1} &, Partition[IntegerDigits[n, 2 s k, s k], k], {2}]]
The examples on page 79 have numbers 3024, 982, 925, 1971, 2506 and 1953.
To check whether an array list contains only arrangements of colors corresponding to allowed templates one can then use
SatisfiedQ[list_, allowed_] := Apply[And, Map[MatchQ[#, allowed] &, Partition[list, {3, 3}, {1, 1}], {2}], {0, 1}]
[i, j, m], {i, 0, t - 1}, {j, Max[1, n - i], n + i}, {k, 0, ktot - 1}, {m, k + 1, ktot - 1}], [0, s], Cases[MapIndexed[ [Abs[n - First[#2]], First[#2], #1]&, a], [x_, _, _] /; x < t], Table[ [Abs[n - i], i, 0], {i, Length[a] + 1, n + t - 1}], Table[! [i, j, k] || If[EvenQ[n + i - j], [i, j], False] || [i + 1, j, k], {i, 0, t - 2}, {j, Max[1, n - i], n + i}, {k, 0, ktot - 1}], Table[Map[Function[ z, Outer[! … [i, j, z 〚 1, 2 〛 ] || ## &, Apply[Sequence, Map[If[i < t - 1, { [i + 1, # 〚 1 〛 ], [ i + 1, j - # 〚 3 〛 ], [i + 1, j, # 〚 2 〛 ]}, { [i + 1, j - # 〚 3 〛 ]}]&, z 〚 2 〛 ]]]], rules], {i, 0, t - 1}, {j, n + i, Max[1, n - i], -2}], Apply[Or, Table[ [i, 0], {i, n, t, 2}]]} /.
Run-length encoding
Data can be converted to run lengths by Map[Length, Split[data]] .
Non-deterministic Turing machines
Generalizing rules from page 888 by making each right-hand side a list of possible outcomes, the list of configurations that can be reached after t steps is given by
NTMEvolve[rule_, inits_, t_Integer] := Nest[ Union[Flatten[Map[NTMStep[rule, #]&, #], 1]]&, inits, t]
NTMStep[rule_List, {s_, a_, n_}] /; 1 ≤ n ≤ Length[a] := Apply[{#1, ReplacePart[a, #2, n], n + #3}&, Replace[{s, a 〚 n 〛 }, rule], {1}]
Applying BitReverseOrder to this matrix yields a matrix which has an essentially nested form, and for size n = 2 s can be obtained from
Nest[With[{c = BitReverseOrder[Range[0, Length[#] - 1]/ Length[#]]}, Flatten2D[MapIndexed[#1 {{1, 1}, {1, -1} (-1)^c 〚 Last[#2] 〛 } &, #, {2}]]] &, {{1}}, s]
Using this structure, one obtains the so-called fast Fourier transform which operates in n Log[n] steps and is given by
With[{n = Length[data]}, Fold[Flatten[Map[With[ {k = Length[#]/2}, {{1, 1}, {1, -1}} .
Arithmetic systems [emulating register machines]
Given the program for a register machine with nr registers in the form on page 896 , an arithmetic system which emulates it can be obtained from
RMToAS[prog_, nr_] := With[{p = Length[prog], g = Product[Prime[j], {j, nr}]}, {p g, Sort[Flatten[MapIndexed[ With[{n = First[#2] - 1}, #1 /. … The evolution of the arithmetic system is given by
ASEvolveList[{n_, rules_}, init_, t_] := NestList[(Mod[#, n] /. rules)[#] &, init, t]
Given a value m obtained in the evolution of the arithmetic system, the state of the register machine to which it corresponds is
{Mod[m, p] + 1, Map[Last, FactorInteger[ Product[Prime[i], {i, nr}] Quotient[m, p]]] - 1}
Note that it is possible to have each successive step involve only multiplication, with no addition, at the cost of using considerably larger numbers overall.
The total number of commutative groups with k elements is just
Apply[Times, Map[PartitionsP[Last[#]] &, FactorInteger[k]]]
(Relabelling of elements makes the number of possible operator forms up to k!
Implementation [of hexagonal cellular automata]
One can treat hexagonal lattices as distorted square lattices, updated according to
CAStep[rule_List, a_] := Map[rule 〚 14 - # 〛 &, a + 2 ListConvolve[{{1, 1, 0}, {1, 0, 1}, {0, 1, 1}}, a, 2], {2}]
where rule = IntegerDigits[code, 2, 14] .