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

2, 3, 7, 8, 10, 14, 16, 18, 21, 23, 29, 31, 35, 41, 42, 44, 48, 50, 54, 56, 60, 62, 66, 70, 72, 76, 78, 80, 82, 84, 86, 88, 93, 97, 99, 103, 109, 111, 115, 117, 123, 125, 129, 131, 137, 141, 143, 147, 153, 155, 159, 161, 165, 167, 171, 173, 179, 183, 186, 188

Offset

1,1

Comments

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:

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

1 ..... 1 ........ no

2 ..... x ........ yes

3 ..... 1+x ...... yes

4 ..... x^2 ...... no

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

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

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

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

9 ..... x+x^2 .... no

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

11 .... x^3 ...... no

...

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

A206822, irreducible

A206829, number of distinct factors

A207187, multiples of x+1

A207188, multiples of x

A207189, multiples of x-1

A207190, multiples of x^2+1

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

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

Links

Table of n, a(n) for n=1..60.

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} *)
w = {}; Do[n++; If[IrreduciblePolynomialQ[y[[n]]], AppendTo[w, n]], {n, 200}]
w                          (* A206821 *)
Complement[Range[200], w]  (* A206822 *)

Crossrefs

Cf. A206073, A206284, A206822.

Sequence in context: A225378 A028808 A029718 * A323003 A051468 A002274

Adjacent sequences: A206818 A206819 A206820 * A206822 A206823 A206824

Keyword

nonn

Author

Clark Kimberling, Feb 12 2012

Status

approved