A206829 Number of distinct irreducible factors of the polynomial y(n,x) defined at A206821.
0, 1, 1, 1, 2, 2, 1, 1, 2, 1, 1, 2, 3, 1, 2, 1, 2, 1, 2, 2, 1, 2, 1, 2, 2, 1, 3, 3, 1, 3, 1, 2, 2, 2, 1, 2, 2, 2, 2, 2, 1, 1, 3, 1, 2, 2, 2, 1, 2, 1, 2, 2, 2, 1, 3, 1, 1, 2, 4, 1, 3, 1, 2, 2, 3, 1, 2, 2, 2, 1, 3, 1, 2, 2, 2, 1, 2, 1, 3, 1, 2, 1, 3, 1, 2, 1, 2, 1, 2, 2, 2, 3, 1, 2, 2, 2, 1, 3, 1
Offset: 1
Keywords
Examples
y(5,x) = (x-1)(x+1), so a(5)=2.
Crossrefs
Cf. A206821.
Programs
-
Mathematica
t = Table[IntegerDigits[n, 2], {n, 1, 1000}]; b[n_] := Reverse[Table[x^k, {k, 0, n}]] p[n_] := p[n] = t[[n]].b[-1 + Length[t[[n]]]] TableForm[Table[{n, p[n], Factor[p[n]]}, {n, 1, 6}]] f[k_] := 2^k - k; g[k_] := 2^k - 2 + f[k - 1]; q1[n_] := p[2^(k - 1)] - p[n + 1 - f[k]] q2[n_] := p[n - f[k] + 2] y1 = Table[p[n], {n, 1, 4}]; Do[AppendTo[y1, Join[Table[q1[n], {n, f[k], g[k] - 1}], Table[q2[n], {n, g[k], f[k + 1] - 1}]]], {k, 3, 8}] y = Flatten[y1]; (* polynomials over {-1,0,1} *) TableForm[Table[{n, y[[n]], Factor[y[[n]]]}, {n, 1, 10}]] Table[-1 + Length[FactorList[y[[n]]]], {n, 1, 120}] (* A206829 *)
Comments