A248930 - OEIS

%I #30 Jan 28 2021 01:35:15

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

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

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

%N Decimal expansion of c = 2*Product_{prime p == 3 (mod 4)} (1 - 2/(p*(p-1)^2)), 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 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.

%e 1.64933768909803...

%t kmax = 25; 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}]; c = 2*P[kmax]; RealDigits[c, 10, 15] // 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*Exp[sump], digits]], 10, digits - 1][[1]] (* _Vaclav Kotesovec_, Jan 16 2021 *)

%Y Cf. A002145, A052483, A189226, A189227.

%K nonn,cons

%O 1,2

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

%E More digits from _Vaclav Kotesovec_, Jun 27 2020