|
%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
|
