A257395 - OEIS

%I #14 Nov 19 2015 08:06:26

%S 1,7,6,7,1,9,5,7,8,5,6,2,9,3,7,4,3,4,7,5,7,2,1,5,9,2,6,1,8,5,7,4,1,8,

%T 6,1,1,2,5,3,7,8,0,2,9,9,3,1,3,2,0,1,3,4,9,7,3,2,3,5,3,7,2,4,8,1,3,2,

%U 5,5,7,2,6,6,2,8,1,8,4,1,4,2,8,5,7,7,3,1,8,2,3,5,1,4,7,8,6,5,7,8,1,1,0,4

%N Decimal expansion of the y-coordinate of the inflection point of product{1 + x^k, k >= 1} that has minimal x-coordinate.

%C The function product{1 + x^k, k >= 1} has two inflection points:  (-0.78983..., 0.17671...) and (-0.23233..., 0.80084...).

%e y = 0.1767195785629374347572159261857418...

%t f[x_] := f[x] = Product[(1 + x^k), {k, 1, 1000}];

%t p[x_, z_] := Sum[n/(x + x^(1 - n)), {n, z}]^2 + Sum[(n*x^(n - 2)*(n - x^n - 1))/(1 + x^n)^2, {n, z}];

%t Plot[f[x], {x, -1, 1}] (* plot showing 2 infl. pts. *)

%t t = x /. FindRoot[p[x, 1000], {x, -0.8}, WorkingPrecision -> 100] (* A257394 *)

%t u = f[t] (* A257395 *)

%t v = x /. FindRoot[p[x, 200], {x, -0.3}, WorkingPrecision -> 100]  (* A257396 *)

%t w = f[v] (* A257397 *)

%t RealDigits[t, 10][[1]]  (* A257394 *)

%t RealDigits[u, 10][[1]]  (* A257395 *)

%t RealDigits[v, 10][[1]]  (* A257396 *)

%t RealDigits[w, 10][[1]]  (* A257397 *)

%t (* _Peter J. C. Moses_, Apr 21 2015 *)

%t digits = 104; QP = QPochhammer; QPP[x_] := With[{dx = 10^-digits}, (QP[-1, x+dx] - QP[-1, x-dx ])/(4*dx)]; x0 = x /. NMaximize[{QPP[x], -1 < x < -1/2}, x, WorkingPrecision -> 4 digits][[2]]; y = QP[-1, x0]/2; RealDigits[y, 10, digits][[1]] (* _Jean-François Alcover_, Nov 19 2015 *)

%Y Cf. A257394, A257396, A257397.

%K nonn,cons,easy

%O 0,2

%A _Clark Kimberling_, Apr 22 2015

%E More digits from _Jean-François Alcover_, Nov 19 2015