2
$\begingroup$

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

$\endgroup$
  • $\begingroup$ can you give one example of what you need, because i didn't get it! $\endgroup$ – Alrubaie Apr 5 at 18:53
  • $\begingroup$ 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? $\endgroup$ – Roman Apr 5 at 19:40
5
$\begingroup$

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}  *)
$\endgroup$
  • $\begingroup$ those last three terms match oeis.org/A013745 Using A038111(n)/A038110 reduced fraction of Primorial/EulerPhi might allow checking more terms. $\endgroup$ – Jamie M Apr 6 at 13:12
  • 1
    $\begingroup$ @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. $\endgroup$ – Michael E2 Apr 6 at 16:21
  • $\begingroup$ 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[0]^2/( EulerPhi[Primorial[0]] EulerPhi[Primorial[1]])] $\endgroup$ – Jamie M Apr 6 at 16:52
  • 1
    $\begingroup$ @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. $\endgroup$ – Michael E2 Apr 6 at 22:04
  • 1
    $\begingroup$ @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. $\endgroup$ – Michael E2 Apr 7 at 13:13
2
$\begingroup$

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}

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.