A345209 - OEIS

%I #26 Sep 12 2021 22:35:28

%S 1,1,3,4,6,6,21,16,27,12,66,24,78,42,36,64,136,162,190,48,252,132,253,

%T 192,150,156,243,168,870,72,496,256,396,816,252,648,666,1140,468,384,

%U 1722,504,903,1056,324,1518,3243,1536,1029,300,816,624,1378,1458,3960,1344,1140,1740,1770,576

%N Number of Petrie polygons on the regular triangular map corresponding to the principal congruence subgroup Gamma(n) of the modular group.

%C To each principal congruence subgroup Gamma(n) of the modular group Gamma = PSL(2,Z) there corresponds a regular triangular map (it is the quotient of the Farey map by Gamma(n)). A Petrie polygon is a closed left-right zig-zagging path on the map. a(n) is the number of such paths.

%H Tom Harris, <a href="/A345209/b345209.txt">Table of n, a(n) for n = 1..1000</a>

%H F. Klein, <a href="https://doi.org/10.1007/BF01677143">Ueber die Transformation siebenter Ordnungder elliptischen Funktionen</a>, Mathematische Annalen, 14 (1878), 428-471.

%H D. Singerman and J. Strudwick, <a href="https://doi.org/10.26493/1855-3974.864.e9b">Petrie polygons, Fibonacci sequences and Farey maps</a>, Ars Mathematica Contemporanea, 10 (2016), 349-357.

%F a(n) = A001766(n)/A301759(n), n >= 3 (Corollary 7.3 of Singerman & Strudwick)

%e The regular triangular map corresponding to Gamma(3) is the tetrahedron; one can easily check by hand that there are 3 distinct closed left-right zigzag paths (Petrie polygons) along the edges of the tetrahedron, so a(3) = 3.

%e Similarly, there are a(4) = 4 and a(5) = 6 such paths on the octahedron and the icosahedron, the maps corresponding to Gamma(4), and Gamma(5) respectively.

%e The map corresponding to Gamma(7) is the Klein map on his quartic curve. There are 21 Petrie polygons on this map; Klein drew 3 of them in his 1878 paper on the quartic, and the others can be found by rotating these through 2*Pi*k/7, k=1,...,6.

%t b[n_] := (n^3/2) Times @@ (1-1/Select[Range[n], Mod[n, #] == 0 && PrimeQ[#]&]^2);

%t c[n_] := With[{F = Fibonacci}, For[k = 1, True, k++, If[Mod[F[k], n] == 0 && (Mod[F[k+1], n] == 1 || Mod[F[k+1], n] == n-1), Return[k]]]];

%t a[n_] := If[n<3, 1, b[n]/c[n]];

%t Array[a, 60] (* _Jean-François Alcover_, Jun 11 2021 *)

%t Table[((n^3/2^Boole[n > 1]) Product[1 - 1/k^2, {k, Select[Divisors[n], PrimeQ]}])/NestWhile[# + 1 &, 1, ! (Mod[Fibonacci[#], n] == 0 && With[{f = Mod[Fibonacci[# + 1], n]}, f == 1 || f == n - 1]) &], {n, 60}] (* _Jan Mangaldan_, Sep 12 2021 *)

%o (Python)

%o from sympy import primedivisors

%o def a(n):

%o     # degenerate cases

%o     if n == 1 or n == 2:

%o         return 1

%o     # calculate index of Γ(n) in Γ

%o     index = n**3

%o     for p in primefactors(n):

%o         index *= (p**2 - 1)

%o         index //= p**2

%o     index //= 2

%o     # calculate pisano semiperiod

%o     sigma = 1

%o     a, b = 1, 1

%o     while (a,b) != (0,1) and (a,b) != (0, n - 1):

%o         a, b = b, (a + b) % n

%o         sigma += 1

%o     # number of petrie polygons = index / sigma

%o     return index // sigma

%Y A301759 gives the lengths of the Petrie polygons on the map in question.

%K nonn,easy,walk

%O 1,3

%A _Tom Harris_, Jun 10 2021