login
Least n such that L(n)<-1 and L(n)<L(n-1), where L(k) means the least root of the polynomial p(k,x) defined at A206284, and a(1)=13.
2

%I #16 Mar 14 2014 02:01:13

%S 13,53,213,853,3413,13653,54613,218453,873813,3495253

%N Least n such that L(n)<-1 and L(n)<L(n-1), where L(k) means the least root of the polynomial p(k,x) defined at A206284, and a(1)=13.

%C A206074 gives an ordering {p(n,x)} of the polynomials with coefficients in {0,1}. The least n for which p(n,x) has a root r less than -1 is 13, hence the choice of 13 as the initial term of A206443. (Specifically, p(13,x)=1+x^2+x^3, and r=-1.46557...) The next p(n,x) having a root less than -1 and <r is p(53,x)=1+x^2+x^4+x^5, with least root -1.57014...

%C The first 10 terms of A206444 are also the 2nd through 11th terms of A072197.

%t highs := {First /@ #, Most[FoldList[Plus, 1, Length /@ #]]} &[Split[Rest[FoldList[Max, -\[Infinity], #]]]] &

%t f[polyInX_] := {Min[#], Max[#]} &[

%t Map[#[[1]] &, DeleteCases[Map[{#, Head[#]} &, Chop[N[x /. Solve[polyInX == 0, x], 40]]], {_, Complex}]]]

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

%t b[n_] := Reverse[Array[x^(# - 1) &, {n + 1}]]

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

%t Table[p[n], {n, 1, 25}]

%t fitCriterion = Intersection[Map[#[[1]] &, DeleteCases[

%t Table[{n, Boole[IrreduciblePolynomialQ[p[n]]]}, {n, 1, #}], {_, 0}]], Map[#[[1]] &, DeleteCases[

%t Table[{n, CountRoots[#, {x, -Infinity, 0}] -

%t CountRoots[#, {x, -1, 0}] &[p[n]]}, {n, 1, #}],

%t {_, 0}]]] &[Length[t]];

%t polyNum = Map[{f[p[#]][[1]], #} &, fitCriterion];

%t up = Map[polyNum[[#]] &, highs[Map[#[[1]] &, polyNum]][[2]]]

%t down = Map[polyNum[[#]] &, highs[Map[#[[1]] &, -polyNum]][[2]]]

%t Table[up[[k, 2]], {k, 1, Length[up]}] (* A206443 *)

%t Table[down[[k, 2]], {k, 1, Length[down]}] (* A206444 *)

%t (* _Peter J. C. Moses_, Feb 06 2012 *)

%Y Cf. A206074, A206443.

%K nonn

%O 1,1

%A _Clark Kimberling_, Feb 07 2012

%E a(8)-a(10) from _Robert G. Wilson v_, Feb 11 2012