Displaying the number of repeating digits in a fraction

Question

I would like to check how many repeating digits are in a large fraction, I manually did it for the first few, but the repeating length is too large to manually check.

Primorial[n_] := Times @@ Prime[Range[n]]

a = Primorial[0]/EulerPhi[Primorial[0]];
b = Primorial[1]/EulerPhi[Primorial[1]];
c = Primorial[2]/EulerPhi[Primorial[1]];
d = Primorial[3]/EulerPhi[Primorial[2]];
e = Primorial[4]/EulerPhi[Primorial[3]];
f = Primorial[5]/EulerPhi[Primorial[4]];
g = Primorial[6]/EulerPhi[Primorial[5]];
h = Primorial[7]/EulerPhi[Primorial[6]];
i = Primorial[8]/EulerPhi[Primorial[7]];
j = Primorial[9]/EulerPhi[Primorial[8]];
k = Primorial[10]/EulerPhi[Primorial[9]];
l = Primorial[11]/EulerPhi[Primorial[10]];
m = Primorial[12]/EulerPhi[Primorial[11]];
n = Primorial[13]/EulerPhi[Primorial[12]];
o = Primorial[14]/EulerPhi[Primorial[13]];
p = Primorial[15]/EulerPhi[Primorial[14]];

(*
a*b*c*d*e*f*g*h*i*j*k  has 81 long repeating fraction
a*b*c*d*e*f*g*h*i*j*k*l has 729 long repeating fraction
a*b*c*d*e*f*g*h*i*j*k*l*m 59049 long repeating fraction
*)

I would like to check the repeating fraction length for a*b*c*d*e*f*g*h*i*j*k*l*m*n and beyond if possible, since I'm curious if this is related to OEIS sequence: 81,729,59049,... either: A121858 or A215272

Thanks!

cheers, Jamie

Answer 1

The period of the decimal expansion of a fraction $p/q$ is equal to the multiplicative order of $10 \mkern-10mu \mod q^*$, where $q = 2^a5^bq^*$ and neither $2$ nor $5$ divides $q^*$.

ClearAll[fracPer, vp];
(* p-adic order *)
vp[p_?PrimeQ, n_Integer] := Length@NestWhileList[#/p &, n/p, IntegerQ] - 1;
(* fraction decimal expansion period *)
fracPer[q_Integer] := 0;
fracPer[q_Rational] := Module[{den, p2, p5},
   den = Denominator[q];
   p2 = vp[2, den];
   p5 = vp[5, den];
   den = den/2^p2/5^p5;
   If[den == 1,
    0,
    MultiplicativeOrder[10, den]
    ]
   ];

Example:

iter[{periods_, frac_, n_}] := {{periods, fracPer[#]}, #, n + 1} &[
   frac*Primorial[n]/EulerPhi[Primorial[Max[1, n - 1]]]];
Flatten@ First@ Nest[iter, {0, Primorial[0]/EulerPhi[Primorial[0]], 0}, 15]
(*  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 27, 729, 59049, 43046721, 31381059609}  *)

Answer 2

Is this what you mean? The decimal representation of a*b*c*d*e*f*g*h*i*j*k has the repeating digits {4, 6, 5, 0, 2, 0, 5, 7, 6, 1, 3, 1, 6, 8, 7, 2, 4, 2, 7, 9, 8, 3, 5, 3, 9, 0, 9}, which is a sequence of length 27:

RealDigits[a*b*c*d*e*f*g*h*i*j*k]

{{3, 1, 6, 3, 7, 3, 8, 3, 9, 1, 1, 8, 5, 0, 7, 5, 7, 6, 7, 1, 3, 1, 5, 7, 6, 4, 8, 4, 7, 7, 6, 6, 0, 4, 9, 8, 6, 9, 4, 7, 6, 8, 7, 1, 2, 0, 4, 7, 1, 9, 6, 2, 1, 9, 4, 8, 7, 4, 4, 5, 3, 4, {4, 6, 5, 0, 2, 0, 5, 7, 6, 1, 3, 1, 6, 8, 7, 2, 4, 2, 7, 9, 8, 3, 5, 3, 9, 0, 9}}, 16}

You get this length from

RealDigits[a*b*c*d*e*f*g*h*i*j*k][[1, -1]] // Length

27

RealDigits[a*b*c*d*e*f*g*h*i*j*k*l][[1, -1]] // Length

729

RealDigits[a*b*c*d*e*f*g*h*i*j*k*l*m][[1, -1]] // Length

59049

---

compact code:

Primorial[n_] := Times @@ Prime[Range[n]]
pp[i_Integer /; 0 <= i <= 1] := Primorial[i]/EulerPhi[Primorial[i]]
pp[i_Integer /; i >= 2] := Primorial[i]/EulerPhi[Primorial[i - 1]]

Table[Length[RealDigits[Product[pp[i], {i, 0, n}]][[1, -1]]], {n, 0, 13}]

{0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 27, 729, 59049, 43046721}