A276183 - OEIS

%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