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.
1234 ...