cp's OEIS Frontend

This is a front-end for the Online Encyclopedia of Integer Sequences, made by Christian Perfect. The idea is to provide OEIS entries in non-ancient HTML, and then to think about how they're presented visually. The source code is on GitHub.

A206443 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.

This page as a plain text file.
%I A206443 #16 Oct 30 2023 11:19:21
%S A206443 13,37,145,157,181,517,565,661,2101,2197,2581,2773,8725,8917,10357,
%T A206443 10453,10837,35029,35413,41173,41557,43093,43861
%N A206443 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 A206443 A206074 gives an ordering {p(n,x)} of the polynomials with coefficients in {0,1}.
%C A206443 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(37,x)=1+x^2+x^5, with least root -1.1938...
%t A206443 highs := {First /@ #, Most[FoldList[Plus, 1, Length /@ #]]} &[Split[Rest[FoldList[Max, -\[Infinity], #]]]] &
%t A206443 f[polyInX_] := {Min[#], Max[#]} &[
%t A206443   Map[#[[1]] &, DeleteCases[Map[{#, Head[#]} &, Chop[N[x /. Solve[polyInX == 0, x], 40]]], {_, Complex}]]]
%t A206443 t = Table[IntegerDigits[n, 2], {n, 1, 100000}];
%t A206443 b[n_] := Reverse[Array[x^(# - 1) &, {n + 1}]]
%t A206443 p[n_] := t[[n]].b[-1 + Length[t[[n]]]]
%t A206443 Table[p[n], {n, 1, 25}]
%t A206443 fitCriterion = Intersection[Map[#[[1]] &, DeleteCases[
%t A206443        Table[{n, Boole[IrreduciblePolynomialQ[p[n]]]}, {n, 1, #}], {_, 0}]], Map[#[[1]] &, DeleteCases[
%t A206443        Table[{n, CountRoots[#, {x, -Infinity, 0}] -
%t A206443        CountRoots[#, {x, -1, 0}] &[p[n]]}, {n, 1, #}],
%t A206443            {_, 0}]]] &[Length[t]];
%t A206443 polyNum = Map[{f[p[#]][[1]], #} &, fitCriterion];
%t A206443 up = Map[polyNum[[#]] &, highs[Map[#[[1]] &, polyNum]][[2]]]
%t A206443 down = Map[polyNum[[#]] &, highs[Map[#[[1]] &, -polyNum]][[2]]]
%t A206443 Table[up[[k, 2]], {k, 1, Length[up]}]      (* A206443 *)
%t A206443 Table[down[[k, 2]], {k, 1, Length[down]}]  (* A206444 *)
%t A206443 (* _Peter J. C. Moses_, Feb 06 2012 *)
%Y A206443 Cf. A206074, A206284, A206444.
%K A206443 nonn,more
%O A206443 1,1
%A A206443 _Clark Kimberling_, Feb 07 2012