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 .