A248938 - OEIS

%I #18 Jun 13 2021 14:19:00

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

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

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

%N Decimal expansion of beta = G^2*(2/3)*Product_{prime p == 3 (mod 4)} (1 - 2/(p*(p-1)^2)) (where G is Catalan's constant), a constant related to the problem of integral Apollonian circle packings.

%H Steven R. Finch, <a href="/A189227/a189227.pdf">Apollonian circles with integer curvatures</a>, p. 6. [Cached copy, with permission of the author]

%H Steven R. Finch, <a href="https://doi.org/10.1017/9781316997741">Mathematical Constants II</a>, Encyclopedia of Mathematics and Its Applications, Cambridge University Press, Cambridge, 2018, p. 256.

%H Elena Fuchs and Katherine Sanden, <a href="http://arxiv.org/abs/1001.1406">Some experiments with integral Apollonian circle packings</a>, arXiv:1001.1406 [math.NT] p. 7.

%H Peter Sarnak, <a href="http://web.math.princeton.edu/sarnak/InternalApollonianPackings09.pdf">Integral Apollonian Packings</a>, Princeton MAA Lecture - January, 2009, p. 21.

%F beta = (G^2/3)*A248930, where G is Catalan's constant A006752.

%e 0.4612609086138613...

%t kmax = 25; Clear[P]; Do[P[k] = Product[p = Prime[n]; If[Mod[p, 4] == 3 , 1 - 2/(p*(p - 1)^2) // N[#, 40]&, 1], {n, 1, 2^k}]; Print["P(", k, ") = ", P[k]], {k, 10, kmax}]; beta = Catalan^2*(2/3)*P[kmax]; RealDigits[beta, 10, 16] // First

%t (* -------------------------------------------------------------------------- *)

%t $MaxExtraPrecision = 1000; digits = 121;

%t f[p_] := (1 - 2/(p*(p - 1)^2));

%t coefs = Rest[CoefficientList[Series[Log[f[1/x]], {x, 0, 1000}], x]];

%t S[m_, n_, s_] := (t = 1; sums = 0; difs = 1; While[Abs[difs] > 10^(-digits - 5) || difs == 0, difs = (MoebiusMu[t]/t) * Log[If[s*t == 1, DirichletL[m, n, s*t], Sum[Zeta[s*t, j/m]*DirichletCharacter[m, n, j]^t, {j, 1, m}]/m^(s*t)]]; sums = sums + difs; t++]; sums);

%t P[m_, n_, s_] := 1/EulerPhi[m] * Sum[Conjugate[DirichletCharacter[m, r, n]] * S[m, r, s], {r, 1, EulerPhi[m]}] + Sum[If[GCD[p, m] > 1 && Mod[p, m] == n, 1/p^s, 0], {p, 1, m}];

%t m = 2; sump = 0; difp = 1; While[Abs[difp] > 10^(-digits - 5) || difp == 0, difp = coefs[[m]]*P[4, 3, m]; sump = sump + difp; m++];

%t RealDigits[Chop[N[2*Catalan^2/3 * Exp[sump], digits]], 10, digits - 1][[1]] (* _Vaclav Kotesovec_, Jan 16 2021 *)

%Y Cf. A006752, A042944, A042946, A052483, A189226, A189227, A248930.

%K nonn,cons

%O 0,1

%A _Jean-François Alcover_, Oct 17 2014

%E More digits from _Vaclav Kotesovec_, Jun 27 2020