|
%I #40 Sep 28 2020 10:03:06
%S 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,1,0,0,1,1,
%T 0,0,1,1,0,1,0,2,1,1,1,2,0,1,0,0,1,2,1,1,1,1,2,3,0,3,1,2,1,1,1,3,2,2,
%U 2,4,0,2,2,2,1,3,2,5,1,2,1,4,1,4,3,3,2,4,1,4,2,4,4,4,1,3,3,2,3,3,1,7
%N Genus of the quotient of the modular curve X_0(n) by the Fricke involution.
%C a(n) is the genus of quotient space H/Gamma_0*(n), where H is the upper half plane and Gamma_0*(n) = Gamma_0(n) + W Gamma_0(n) is the extension of Gamma_0(n) via the involution z <-> W(z) = -n/z (see Cohn, 1988).
%H Gheorghe Coserea, <a href="/A276183/b276183.txt">Table of n, a(n) for n = 1..54321</a>
%H Harvey Cohn, <a href="https://doi.org/10.1090/S0025-5718-1988-0935079-4">Fricke's Two-Valued Modular Equations</a>, Math. Comp. 51 (1988), 787-807.
%H Harvey Cohn, <a href="https://doi.org/10.1007/978-1-4757-4158-2_4">A Numerical Survey of the Reduction of Modular Curve Genus by Fricke's Involutions</a>, Number Theory (New York Seminar 1989-1990), p. 100.
%H Fell, Harriet; Newman, Morris; Ordman, Edward; <a href="http://dx.doi.org/10.6028/jres.067B.006">Tables of genera of groups of linear fractional transformations</a>, J. Res. Nat. Bur. Standards Sect. B 67B 1963 61-68.
%H Andrew P. Ogg, <a href="http://archive.numdam.org/item/SDPP_1974-1975__16_1_A4_0/">Automorphismes de courbes modulaires</a>, Séminaire Delange-Pisot-Poitou. Théorie des nombres, vol. 16, no. 1 (1974-1975), talk no. 7, p. 1.
%F a(n) = (1 + A001617(n))/2 - r * A000003(n)/12 for all n > 4, where r=4 for n=3 (mod 8), r=6 for n=7 (mod 8) and r=3 otherwise.
%F a(n) <> 4884 for all n.
%e G.f. = x^22 + x^28 + x^30 + x^33 + x^34 + x^37 + x^38 + x^40 + 2*x^42 + x^43 + x^44 + ...
%t f[n_] := If[n < 1, 0, 1 + Sum[MoebiusMu[d]^2 n/d/12 - EulerPhi[GCD[d, n/d]]/2, {d, Divisors@ n}] - Count[(#^2 - # + 1)/n & /@ Range@ n, _?IntegerQ]/3 - Count[(#^2 + 1)/n & /@ Range@ n, _?IntegerQ]/4];
%t g[n_] := Ceiling[k0 = k /. FindRoot[EllipticK[1 - k^2]/EllipticK[k^2] == Sqrt@ n, {k, 1/2, 10^-10, 1}, WorkingPrecision -> 600, MaxIterations -> 100]; Exponent[MinimalPolynomial[RootApproximant[k0^2, 24], x], x]/2];
%t r[n_] := If[MemberQ[{3, 7}, #], 3 + (# - 1)/2, 3] &@ Mod[n, 8]; a[n_] := If[n <= 4, 0, (1 + f@ n)/2 - r[n] g[n]/12]; Table[Print["a(", n, ") = ", an = a[n]]; an, {n, 102}] (* _Michael De Vlieger_, Oct 28 2016, after _Michael Somos_ at A001617 and _Jean-François Alcover_ at A000003 *)
%t ClassList[n_?Negative] :=
%t Select[Flatten[#, 1] &@Table[
%t {i, j, (j^2 - n)/(4 i)}, {i, Sqrt[-n/3]}, {j, 1 - i, i}],
%t Mod[#3, 1] == 0 && #3 >= # &&
%t GCD[##] == 1 && ! (# == #3 && #2 < 0) & @@ # &]
%t A001617[n_] := If[n < 1, 0,
%t 1 + Sum[MoebiusMu[d]^2 n/d/12 - EulerPhi[GCD[d, n/d]]/2, {d,
%t Divisors@n}] -
%t Count[(#^2 - # + 1)/n & /@ Range[n], _?IntegerQ]/3 -
%t Count[(#^2 + 1)/n & /@ Range[n], _?IntegerQ]/4];
%t a[n_] := If[0 <= n <= 4, 0, (A001617[n] + 1)/2 - If[Mod[n, 8] == 3, 4, If[Mod[n, 8] == 7, 6, 3]] Length[ClassList[-4 n]]/12] (* _David Jao_, Sep 07 2020 *)
%o (PARI)
%o A000003(n) = qfbclassno(-4*n);
%o A000089(n) = {
%o if (n%4 == 0 || n%4 == 3, return(0));
%o if (n%2 == 0, n \= 2);
%o my(f = factor(n), fsz = matsize(f)[1]);
%o prod(k = 1, fsz, if (f[k, 1] % 4 == 3, 0, 2));
%o };
%o A000086(n) = {
%o if (n%9 == 0 || n%3 == 2, return(0));
%o if (n%3 == 0, n \= 3);
%o my(f = factor(n), fsz = matsize(f)[1]);
%o prod(k = 1, fsz, if (f[k, 1] % 3 == 2, 0, 2));
%o };
%o A001615(n) = {
%o my(f = factor(n), fsz = matsize(f)[1],
%o g = prod(k=1, fsz, (f[k, 1]+1)),
%o h = prod(k=1, fsz, f[k, 1]));
%o return((n*g)\h);
%o };
%o A001616(n) = {
%o my(f = factor(n), fsz = matsize(f)[1]);
%o prod(k = 1, fsz, f[k, 1]^(f[k, 2]\2) + f[k, 1]^((f[k, 2]-1)\2));
%o };
%o A001617(n) = 1 + A001615(n)/12 - A000089(n)/4 - A000086(n)/3 - A001616(n)/2;
%o a(n) = {
%o my(r = if (n%8 == 3, 4, n%8 == 7, 6, 3));
%o if (n < 5, 0, (1 + A001617(n))/2 - r * A000003(n)/12);
%o };
%o vector(102, n, a(n))
%Y Cf. A000003, A000086, A000089, A001615, A001616, A001617, A276181.
%K nonn
%O 1,42
%A _Gheorghe Coserea_, Oct 21 2016
%E New name from _David Jao_, Sep 07 2020
|
