Displaying the number of repeating digits in a fraction

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/EulerPhi[Primorial];
b = Primorial/EulerPhi[Primorial];
c = Primorial/EulerPhi[Primorial];
d = Primorial/EulerPhi[Primorial];
e = Primorial/EulerPhi[Primorial];
f = Primorial/EulerPhi[Primorial];
g = Primorial/EulerPhi[Primorial];
h = Primorial/EulerPhi[Primorial];
i = Primorial/EulerPhi[Primorial];
j = Primorial/EulerPhi[Primorial];
k = Primorial/EulerPhi[Primorial];
l = Primorial/EulerPhi[Primorial];
m = Primorial/EulerPhi[Primorial];
n = Primorial/EulerPhi[Primorial];
o = Primorial/EulerPhi[Primorial];
p = Primorial/EulerPhi[Primorial];

(*
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

• can you give one example of what you need, because i didn't get it! – Alrubaie Apr 5 at 18:53
• For a and b you have Primorial[i]/EulerPhi[Primorial[i]] and from c on you have Primorial[i]/EulerPhi[Primorial[i-1]]. Is this by choice or by mistake? – Roman Apr 5 at 19:40

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/EulerPhi[Primorial], 0}, 15]
(*  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 27, 729, 59049, 43046721, 31381059609}  *)
• those last three terms match oeis.org/A013745 Using A038111(n)/A038110 reduced fraction of Primorial/EulerPhi might allow checking more terms. – Jamie M Apr 6 at 13:12
• @JamieM The above calculates the first 60-70 terms in 1-2 seconds on my machine. (Just change the 15 to a larger number.) Assuming checking more terms is what you'd like to do. – Michael E2 Apr 6 at 16:21
• Hi could you paste the first 10 or 20 values after 31381059609? I tried the two code blocks in one Mathematica notebook but the output is a big list of fractions, so not sure what I did wrong. Thanks. Portion of the output I got: 0, fracPer[Primorial^2/( EulerPhi[Primorial] EulerPhi[Primorial])] – Jamie M Apr 6 at 16:52
• @JamieM I pasted the output for Nest[...,50] here: pastebin.com/raw/tQxTsDzS -- Maybe try ClearAll[iter] and reexecuting the code. Or restart the kernel. The code works for me on a fresh kernel with your definition of Primorial. – Michael E2 Apr 6 at 22:04
• @JamieM Not the present code, but the length of the transient part of the decimal expansion of a fraction x is given by m = Ceiling@Log10[x] + Max[vp[2, Denominator@x], vp[5, Denominator@x]]. You could then get the digits with RealDigits[x, 10, m]. -- BTW, I think you misinterpreted the output of RealDigits: The number is not 3.16... but 3.16... * 10^15. The output is in the form {digits, exponent} and {{3, 1, 6,..}, 16} means 0.316... * 10^16. – Michael E2 Apr 7 at 13:13

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}