Various generalizations of perfect numbers have been considered, requiring for example IntegerQ[DivisorSigma[1, n]/n] (pluperfect) or Abs[DivisorSigma[1, n] - 2n] < r (quasiperfect).

One can count the number of occurrences of each of the k b possible blocks of length b in a given state using BC[list_] := With[{z = Map[FromDigits[#, k] &, Partition[list, b, 1, 1]]}, Map[Count[z, #] &, Range[0, k b - 1]]] Conserved quantities of the kind discussed here are then of the form q . BC[a] where q is some fixed list. A way to find candidates for q is to compute NullSpace[Table[With[{u = Table[Random[Integer, {0, k - 1}], {m}]}, BC[CAStep[u]] - BC[u]], {s}]] for progressively larger m and s , and to see what lists continue to appear.

(a_  s_)  (rtab 〚 i k + a + 1 〛  k 2r (s - 1) + 1 + Mod[i k + a, k 2r ]), {i, 0, k 2r - 1}]&, net], 1] where here elementary rule 126 is specified for example by {2, 1, Reverse[IntegerDigits[126, 2, 8]]} . … The whole procedure can be performed using MinNet[net_, k_:2] := Module[{d = DSets[net, k], q, b}, If[First[d] =!= {}, AllNet[k], q = ISets[b = Map[Table[ Position[d, NetStep[net, #, a]] 〚 1, 1 〛 , {a, 0, k - 1}]&, d]]; DeleteCases[MapIndexed[#2 〚 2 〛 - 1  #1 &, Rest[ Map[Position[q, #] 〚 1, 1 〛 &, Transpose[Map[Part[#, Map[ First, q]]&, Transpose[b]]], {2}]] - 1, {2}], _  0, {2}]]] DSets[net_, k_:2] := FixedPoint[Union[Flatten[Map[Table[NetStep[net, #, a], {a, 0, k - 1}]&, #], 1]]&, {Range[Length[net]]}] ISets[list_] := FixedPoint[Function[g, Flatten[Map[ Map[Last, Split[Sort[Part[Transpose[{Map[Position[g, #] 〚 1, 1 〛 &, list, {2}], Range[Length[list]]}], #]], First[#1]  First[#2]&], {2}]&, g], 1]], {{1}, Range[2, Length[list]]}] If net has q nodes, then in general MinNet[net] can have as many as 2 q -1 nodes.

Note that the total number of integers less than n which can be expressed as a sum of three squares increases roughly like 5n/6 , with fluctuations related to IntegerDigits[n, 4] . … The total number of ways that integers less than n can be expressed as a sum of d squares is equal to the number of integer lattice points that lie inside a sphere of radius Sqrt[n] in d -dimensional space. … The number of ways of writing an integer n as a sum of two primes can be calculated explicitly as Length[Select[n - Table[Prime[i], {i, PrimePi[n]}], PrimeQ]] .

MemberQ[c, #], Append[c, #], AStep[c]]& [f[c] + f[{{1, 0}, {0, 1}, {-1, 0}, {0, -1}}]] f[a_]:=a 〚 Random[Integer, {1, Length[a]}] 〛 This implementation can easily be extended to any type of lattice and any number of dimensions. … With a grid of cells set up in advance, each step in this type of Eden model can be achieved with AStep[a_] := ReplacePart[a, 1, (# 〚 Random[ Integer, {1, Length[#]}] 〛 &)[Position[(1 - a)Sign[ ListConvolve[{{0, 1, 0}, {1, 0, 1}, {0, 1, 0}}, a, {2, 2}]], 1]]] This implementation can readily be extended to generalized aggregation models (see below ).

At step n , the complete array of cells is Table[If[FreeQ[Transpose[IntegerDigits[{i, j}, k, n]], form], 1, 0], {i, 0, k n - 1}, {j, 0, k n - 1}] where for the pattern on page 187 , k = 2 and form = {0, 1} .

Fibonacci[n] can be obtained in many ways: • (GoldenRatio n - (-GoldenRatio) -n )/ √ 5 • Round[GoldenRatio n / √ 5 ] • 2 1 - n Coefficient[(1 + √ 5 ) n , √ 5 ] • MatrixPower[{{1, 1}, {1, 0}}, n - 1] 〚 1, 1 〛 • Numerator[NestList[1/(1 + #)&, 1, n]] • Coefficient[Series[1/(1 - t - t 2 ), {t, 0, n}], t n - 1 ] • Sum[Binomial[n - i - 1, i], {i, 0, (n - 1)/2}] • 2 n - 2 - Count[IntegerDigits[Range[0, 2 n - 2 ], 2], {___, 1, 1, ___}] A fast method for evaluating Fibonacci[n] is First[Fold[f, {1, 0, -1}, Rest[IntegerDigits[n, 2]]]] f[{a_, b_, s_}, 0] = {a (a + 2b), s + a (2a - b), 1} f[{a_, b_, s_}, 1] = {-s + (a + b) (a + 2b), a (a + 2b), -1} Fibonacci numbers appear to have first arisen in perhaps 200 BC in work by Pingala on enumerating possible patterns of poetry formed from syllables of two lengths. … It appears to be zero only when n is of the form 5 m or 12q , where q is not prime ( q > 5 ).

The output f[x] in such cases is always 2 u - 1 where u = Nest[(13 + (6# + 8)(5/2)^ IntegerExponent[6# + 8, 2])/6 &, 1, s + 1] One then finds that 6u + 8 has the form Nest[If[EvenQ[#], 5#/2, # + 21]&, 14, m] for some m , suggesting a connection with the number theory systems of page 122 . The corresponding halting time t[x] is Last[Nest[h, {8, 4s + 24 }, s]] - 1 with h[{i_, j_}] := With[{e = IntegerExponent[3i + 4, 2]}, {13/6 + (i + 4/3)(5/2) e + 1 , ((154 + 75(i + 4/3)(5/2) e ) 2 - 16321 - 7860i - 900i 2 + 3360e)/3780 + j}] For s > 3 it then turns out that f[x] is extremely close to 3560523 (5/2) r , and t[x] to 18865098979373 (5/2) 2r , for some integer r . … But if IntegerDigits[x, 2] involves no consecutive 0's then for example f[x] can be obtained from 2^(b[Join[{1, 1}, #], Length[#]] &)[IntegerDigits[x, 2]] - 1 a[{l_, _}, r_] := ({l + (5r - 3#)/2, #} &)[Mod[r, 2]] a[{l_, 0}, 0] := {l + 1, 0} a[{l_, 1}, 0] := ({(13 + #(5/2)^IntegerExponent[#, 2])/6, 0} &[6l + 2] b[list_, i_] := First[Fold[a, {Apply[Plus, Drop[list, -i]], 0}, Apply[Plus, Split[Take[list, -i], #1  #2 ≠ 0 &], 1]]] (The corresponding expression for t[x] is more complicated.)

Polynomial value sets Closely related to issues of solving Diophantine equations is the question of what set of positive values a polynomial can achieve when fed all possible positive integer values for its variables. … This is the simplest polynomial giving Fibonacci[n] , and there are for example no polynomials with 2 variables, up to 4 terms, total degree less than 4, and integer coefficients between -2 and +2, that give any of 2 n , 3 n or Prime[n] . Nevertheless, from the representation for PrimeQ in the note above it has been shown that the positive values of a particular polynomial with 26 variables, 891 terms and total degree 97 are exactly the primes.

This can be done for blocks up to length n in a 1D cellular automaton with k colors using ReversibleQ[rule_, k_, n_] := Catch[Do[ If[Length[Union[Table[CAStep[rule, IntegerDigits[i, k, m]], {i, 0, k m - 1}]]] ≠ k m , Throw[False]], {m, n}]; True] For k = 2 , r = 1 it turns out that it suffices to test only up to n = 4 (128 out of the 256 rules fail at n = 1 , 64 at n = 2 , 44 at n = 3 and 14 at n = 4 ); for k = 2 , r = 2 it suffices to test up to n = 15 , and for k = 3 , r = 1 , up to n = 9 .