login
Numbers that match irreducible polynomials over {-1,0,1} with leading coefficient 1.
9

%I #12 Jul 12 2012 00:40:00

%S 2,3,7,8,10,14,16,18,21,23,29,31,35,41,42,44,48,50,54,56,60,62,66,70,

%T 72,76,78,80,82,84,86,88,93,97,99,103,109,111,115,117,123,125,129,131,

%U 137,141,143,147,153,155,159,161,165,167,171,173,179,183,186,188

%N Numbers that match irreducible polynomials over {-1,0,1} with leading coefficient 1.

%C The monic polynomials y(n,x) having coefficients in {-1,0,1} are matched to the set N of positive integers as follows. First, the monic polynomials p(n,x) having coefficients in {0,1} are matched to N as in A206074; i.e., the polynomial x^d(0) + x^d(1) + ... + d(n), where d(i) is 0 or 1 for 0<=i<=n and d(0)=1, matches the binary number d(0)d(1)...d(n). Then monic polynomials having at least one negative coefficient are then inserted among the polynomials p(n,x), as follows: x-1 goes between x and x+1, and for k>1, the polynomials x^k-p(n,x), for 0<n<2^k, go between x^k and x^k+1, in this order: x^k-p(1,x), x^k-p(2,x),..., x^k-p(2^k-1,x). A program in the Mathematica section generates the resulting polynomials in the order just described. The n-th polynomial, denoted here as y(n,x), can be obtained as y[[n]] from the program. The first 11 polynomials, marked "yes" if irreducible over the field of rational numbers, are shown here:

%C n ..... y(n,x) ... irreducible

%C 1 ..... 1 ........ no

%C 2 ..... x ........ yes

%C 3 ..... 1+x ...... yes

%C 4 ..... x^2 ...... no

%C 5 .... -1+x^2 .... no

%C 6 .... -x+x^2 .... no

%C 7 .... -1-x+x^2 .. yes

%C 8 ..... 1+x^2 .... yes

%C 9 ..... x+x^2 .... no

%C 10 .... 1+x+x^2 .. yes

%C 11 .... x^3 ...... no

%C ...

%C Guide to sequences based on the polynomials y(n,x):

%C A206822, irreducible

%C A206829, number of distinct factors

%C A207187, multiples of x+1

%C A207188, multiples of x

%C A207189, multiples of x-1

%C A207190, multiples of x^2+1

%C A207191, even: y(n,-x)=y(n,x)

%C A207192, odd: y(n,-x)=-y(n,x)

%t t = Table[IntegerDigits[n, 2], {n, 1, 1000}];

%t b[n_] := Reverse[Table[x^k, {k, 0, n}]];

%t p[n_] := p[n] = t[[n]].b[-1 + Length[t[[n]]]];

%t TableForm[Table[{n, p[n], Factor[p[n]]}, {n, 1, 6}]]

%t f[k_] := 2^k - k; g[k_] := 2^k - 2 + f[k - 1];

%t q1[n_] := p[2^(k - 1)] - p[n + 1 - f[k]];

%t q2[n_] := p[n - f[k] + 2];

%t y1 = Table[p[n], {n, 1, 4}];

%t Do[AppendTo[y1,Join[Table[q1[n], {n, f[k], g[k] - 1}],

%t Table[q2[n], {n, g[k], f[k + 1] - 1}]]], {k, 3, 8}]

%t y = Flatten[y1]; (* polynomials over {-1,0,1} *)

%t w = {}; Do[n++; If[IrreduciblePolynomialQ[y[[n]]], AppendTo[w, n]], {n, 200}]

%t w (* A206821 *)

%t Complement[Range[200], w] (* A206822 *)

%Y Cf. A206073, A206284, A206822.

%K nonn

%O 1,1

%A _Clark Kimberling_, Feb 12 2012