|
%I #15 Nov 19 2015 07:21:44
%S 7,8,9,8,3,4,8,5,6,9,1,0,1,1,2,2,8,5,4,4,2,6,5,1,4,6,4,7,4,6,9,3,1,2,
%T 7,1,8,4,4,4,3,4,0,5,8,4,1,8,3,1,1,6,3,8,5,3,6,6,9,3,4,6,4,7,9,5,8,9,
%U 1,4,5,6,1,4,8,1,8,0,1,6,3,5,3,3,0,9,9,2,4,4,5,6,1,2,7,6,1,2,8,5,6,8,3,9,6
%N Decimal expansion of the negated x-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 x = -0.7898348569101122854426514647469312...
%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 = 105; 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]]; RealDigits[x0, 10, digits] // First (* _Jean-François Alcover_, Nov 19 2015 *)
%Y Cf. A257395, A257396, A257397.
%K nonn,cons,easy
%O 0,1
%A _Clark Kimberling_, Apr 22 2015
%E More digits from _Jean-François Alcover_, Nov 19 2015
|
