A206330 Numbers that match polynomials irreducible over the integers.

3, 4, 5, 6, 9, 10, 17, 18, 19, 20, 21, 22, 29, 30, 33, 34, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 53, 54, 55, 56, 57, 58, 59, 60, 69, 70, 73, 74, 77, 78, 81, 82, 83, 84, 87, 88, 97, 98, 101, 102, 105, 106, 109, 110, 113, 114, 117, 118, 119, 120, 123

Offset

1,1

Comments

Each n>1 matches a polynomial having integer coefficients

determined by the prime factorization of n. Let c be a

positive integer, and write

c=p(1)^e(1) * p(2)^e(2) * ... * p(k)^e(k), and

define p(n,x) = e(1) + e(2)x + e(3)x^2 + ... + e(k)x^k.

If c/d is a rational number with GCD(c,d)=1, define

Q(c/d,x)=p(c,x)-p(d,x). Let c(n)/d(n) be the n-th

positive rational number given by the canonical

bijection; i.e., c(n)=A038568(n)/A038569(n).

Define P(0,x)=1 and P(n,x)=Q(c(n)/d(n),x). Polynomials

having nonnegative integer coefficients are matched to

the nonnegative integers as follows:

...

n .... P[n,x] .. irreducible

0 .... 0 ....... no

1 ... -1 ....... no

2 .... 1 ....... no

3 ... -x ....... yes

4 .... x ....... yes

5 ... 1-x ...... yes

6 .. -1+x ...... yes

7 .. -2 ........ no

8 ... 2 ........ no

9 .. -2+x ...... yes

10 .. 2-x ...... yes

Links

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

Example

In the table under Comments, read "yes" for n=3,4,5,6,9,10.

Mathematica

b[n_] := Table[x^k, {k, 0, n}];
f[n_] := f[n] = FactorInteger[n]; z = 1000;
t[n_, m_, k_] := If[PrimeQ[f[n][[m, 1]]] && f[n][[m, 1]]
 == Prime[k], f[n][[m, 2]], 0];
u = Table[Apply[Plus,
    Table[Table[t[n, m, k], {k, 1, PrimePi[n]}], {m, 1,
      Length[f[n]]}]], {n, 1, z}];
c[n_] := Module[{s = 1, k = 2, j = 1},
   While[s <= n, s = s + 2*EulerPhi[k]; k = k + 1];
   s = s - 2*EulerPhi[k - 1];
   While[s <= n, If[GCD[j, k - 1]
      == 1, s = s + 2]; j = j + 1];
   If[s > n + 1, j - 1, k - 1]];
d[n_] := Module[{s = 1, k = 2, j = 1},
   While[s <= n, s = s + 2*EulerPhi[k]; k = k + 1];
   s = s - 2*EulerPhi[k - 1];
   While[s <= n, If[GCD[j, k - 1]
      == 1, s = s + 2]; j = j + 1];
   If[s > n + 1, k - 1, j - 1]];
P[n_, x_] :=
 u[[c[n]]].b[-1 + Length[u[[c[n]]]]] -
  u[[d[n]]].b[-1 + Length[u[[d[n]]]]]
TableForm[Table[{n, P[n, x], Factor[P[n, x]]},
   {n, 1, z/4}]];
v = {}; Do[n++;
 If[IrreduciblePolynomialQ[P[n, x]], AppendTo[v, n]], {n, z/2}]
v                            (* A206330 *)
Complement[Range[0, 200], v]  (* A206331 *)

Crossrefs

Cf. A206284 (polynomials over the positive integers),

A206331 (complement of A206330).

Sequence in context: A342469 A266322 A136681 * A104373 A047427 A228235

Adjacent sequences: A206327 A206328 A206329 * A206331 A206332 A206333

Keyword

nonn

Author

Clark Kimberling, Feb 06 2012

Status

approved