Search NKS | Online
31 - 40 of 210 for Listable
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}]
Sierpiński pattern
Other ways to generate step n of the pattern shown here in various orientations include:
• Mod[Array[Binomial, {2, 2} n , 0], 2]
(see pages 611 and 870 )
• 1 - Sign[Array[BitAnd, {2, 2} n , 0]]
(see pages 608 and 871 )
• NestList[Mod[RotateLeft[#] + #, 2] &, PadLeft[{1}, 2 n ], 2 n - 1]
(see page 870 )
• NestList[Mod[ListConvolve[{1, 1}, #, -1], 2] &, PadLeft[{1}, 2 n ], 2 n - 1]
(see page 870 )
• IntegerDigits[NestList[BitXor[2#, #] &, 1, 2 n - 1], 2, 2 n ]
(see page 906 )
• NestList[Mod[Rest[FoldList[Plus, 0, #]], 2] &, Table[1, {2 n }], 2 n - 1]
(see page 1034 )
• Table[PadRight[ Mod[CoefficientList[(1 + x) t - 1 , x], 2], 2 n - 1], {t, 2 n }]
(see pages 870 and 951 )
• Reverse[Mod[CoefficientList[Series[1/(1 - (1 + x)y), {x, 0, 2 n - 1}, {y, 0, 2 n - 1}], {x, y}], 2]]
(see page 1091 )
• Nest[Apply[Join, MapThread[ Join, {{#, #}, {0 #, #}}, 2]] &, {{1}}, n]
(compare page 1073 )
The positions of black squares can be found from:
• Nest[Flatten[2# /. {x_, y_} {{x, y}, {x + 1, y}, {x, y + 1}}, 1] &, {{0, 0}}, n]
• Transpose[{Re[#], Im[#]}] &[ Flatten[Nest[{2 #, 2 # + 1, 2 # + } &, {0}, n]]]
(compare page 1005 )
• Position[Map[Split, NestList[Sort[Flatten[{#, # + 1}]] &, {0}, 2 n - 1]], _?
Implementation of totalistic cellular automata
To handle totalistic rules that involve k colors and nearest neighbors, one can add the definition
CAStep[TotalisticCARule[rule_List, 1], a_List] := rule 〚 -1 - (RotateLeft[a] + a + RotateRight[a]) 〛
to what was given on page 867 . The following definition also handles the more general case of r neighbors:
CAStep[TotalisticCARule[rule_List, r_Integer], a_List] := rule 〚 -1 - Sum[RotateLeft[a, i], {i, -r, r}] 〛
One can generate the representation of totalistic rules used by these functions from code numbers using
ToTotalisticCARule[num_Integer, k_Integer, r_Integer] :=
TotalisticCARule[IntegerDigits[num, k, 1 + (k - 1)(2r + 1)], r]
Given a list of blocks such as {{1, 1}, {0}} each element of Flatten[list] can be thought of as a state in a finite automaton or a Markov process (see page 1084 ). The transitions between these states have probabilities given by m[Map[Length, list]] where
m[s_] := With[{q = FoldList[Plus, 0, s]}, ReplacePart[ RotateRight[IdentityMatrix[Last[q]], {0, 1}], 1/Length[s], Flatten[Outer[List, Rest[q], Drop[q, -1] + 1], 1]]]
The average spectrum of sequences generated according to these probabilities can be obtained by computing the correlation function for elements a distance r apart
ξ [list_, r_] := With[{w = (# - Apply[Plus, #]/Length[#] &)[ Flatten[list]]}, w . MatrixPower[ m[Map[Length, list]], r] . w/Length[w]]
then forming Sum[ ξ [Abs[r]] Cos[2 π r ω ], {r, -n/2, n/2}] and taking the limit n ∞ .
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}]
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] . The list representing the complete history of the resulting cyclic tag system can then be interpreted using
Map[Map[Position[#, 1] 〚 1, 1 〛 - 1 &, Partition[#, k]] &, Take[history, {1, -1, n k}]]
This construction is relevant to the proof of the universality of rule 110 starting on page 678 .
Conway considered fraction systems based on rules of the form
FSEvolveList[fracs_, init_, t_] := NestList[First[Select[fracs #, IntegerQ, 1]] &, init, t]
With the choice
fracs = {17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/ 23, 77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1}
starting at 2 the result for Log[2, list] is as shown below, where Rest[Log[2, Select[list, IntegerQ[Log[2, #]] &]]] gives exactly the primes.
For a rule with number n the two operations correspond respectively to computing 1 - Reverse[list] and list 〚 {1, 5, 3, 7, 2, 6, 4, 8} 〛 with list = IntegerDigits[n, 2, 8] .
But given t steps in this sequence as a list of 0's and 1's, the following function will reconstruct the rightmost t digits in the starting value of n :
IntegerDigits[First[Fold[{Mod[If[OddQ[#2], 2 First[#1] - 1, 2 First[#1] PowerMod[5, -1, Last[#1]]], Last[#1]], 2 Last[#1]} &, {0, 2}, Reverse[list]]], 2, Length[list]]
With a concentrations list c , the position p of a new element is given by Position[c, Max[c], 1, 1] 〚 1, 1 〛 , while the new list of concentrations is λ c + RotateRight[f, p] where f is a list of depletions associated with addition of a new element at position 1.