Search NKS | Online
21 - 30 of 41 for IntegerQ
![](/common/images/search/spacer.gif)
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 .
![](/common/images/search/spacer.gif)