Search NKS | Online
11 - 20 of 58 for Plus
![](/common/images/search/spacer.gif)
The code numbers in these cases are given by 2/3 (4 n - 1) + Apply[Plus, 4 list ] where n is the number of neighbors, here 5.
After n steps the total length of all stems is given by Apply[Plus, Abs[b]] n .
Implementation [of patterning model]
Given a 2D array of values a and a list of weights w , each step in the evolution of the system corresponds to
WeightedStep[w_List, a_] := Map[If[# > 0, 1, 0]&, Sum[w 〚 1 + i 〛 Apply[Plus, Map[RotateLeft[a, #]&, Layer[i]]], {i, 0, Length[w] - 1}], {2}]
Layer[n_] := Layer[n] = Select[Flatten[Table[{i, j}, {i, -n, n}, {j, -n, n}],1], MemberQ[#, n| - n]&]
(b) (Aliquot sums) The quantity that is plotted is DivisorSigma[1, n] - 2n , equal to Apply[Plus, Divisors[n]] - 2n . … The number of ways of expressing an integer n as the sum of two such squares is 4 Apply[Plus, Im[ ^Divisors[n]]] . … (d) All numbers n can be expressed as the sum of four squares, in exactly 8 Apply[Plus, Select[Divisors[n], (Mod[#, 4] ≠ 0)&]] ways, as established by Carl Jacobi in 1829.
Hump m in the picture of sequence (c) shown is given by
FoldList[Plus, 0, Flatten[Nest[Delete[NestList[Rest, #, Length[#] - 1], 2]&, Append[Table[1, {m}], 0], m]] - 1/2]
The first 2 m elements in the sequence can also be generated in terms of reordered base 2 digit sequences by
FoldList[Plus, 1, Map[Last[Last[#]]&, Sort[Table[{Length[#], Apply[Plus, #], 1 - #}& [ IntegerDigits[i, 2]], {i, 2 m }]]]]
Note that the positive and negative fluctuations in sequence (f) are not completely random: although the probability for individual fluctuations in each direction seems to be the same, the probability for two positive fluctuations in a row is smaller than for two negative fluctuations in a row.
Iterated aliquot sums
Related to case (b) above is a system which repeats the replacement n Apply[Plus, Divisors[n]] - n or equivalently n DivisorSigma[1, n] - n .
The quantity FoldList[Plus, 0, Table[MoebiusMu[i], {i, n}]] behaves very much like a random walk.
Implementation [of conserved quantity test]
Whether a k -color cellular automaton with range r conserves total cell value can be determined from
Catch[Do[ (If[Apply[Plus, CAStep[rule, #] - #] ≠ 0, Throw[False]] &)[ IntegerDigits[i, k, m]], {m, w}, {i, 0, k m - 1}]; True]
where w can be taken to be k 2r , and perhaps smaller.
In d dimensions with k colors, 5-neighbor rules generalize to (2d + 1) -neighbor rules, with
CAStep[{rule_, d_}, a_] := Map[rule 〚 -1 - # 〛 &, a + k AxesTotal[a, d], {d}]
AxesTotal[a_, d_] := Apply[Plus, Map[RotateLeft[a, #] + RotateRight[a, #]&, IdentityMatrix[d]]]
with rule given by IntegerDigits[code, k, k(2d(k - 1) + 1)] .
9-neighbor rules generalize to 3 d -neighbor rules, with
CAStep[{rule_, d_}, a_] := Map[rule 〚 -1 - # 〛 &, a + k FullTotal[a, d], {d}]
FullTotal[a_, d_] := Array[RotateLeft[a, {##}] &, Table[3, {d}], -1, Plus] - a
with rule given by IntegerDigits[code, k, k((3 d - 1)(k - 1) + 1)] .
Every cycle corresponds in effect to a distinct necklace with n beads; with k colors the total number of these is
Apply[Plus, (EulerPhi[n/#] k # &)[Divisors[n]]]/n
The number of cycles of length exactly m is s[m, k]/m , where s[m, k] is defined on page 950 .
![](/common/images/search/spacer.gif)