First two n such that $1355297$ divides$10^{6n+5}-54n-46$ for $n>0$

9

2

I have problem solving this equation, smallest n such that $1355297$ divides $10^{6n+5}-54n-46$. I tried everything using my scientific calculator, but I never got the correct results(!).and finally I gave up!. Could you help me find the first 2 solutions for this equation ? (thanks.)

Bobby H

Posted 2018-02-09T09:51:28.943

Reputation: 93

What did you try in MMA? – Ulrich Neumann – 2018-02-09T09:59:19.190

2@Ulrich What is MMA ? – Bobby H – 2018-02-09T10:00:28.287

Sorry, Mathematica – Ulrich Neumann – 2018-02-09T10:12:00.210

1O yes I am quite sure that $1355297$ divides $(10^{1836828602912}-9*1836828602911-10)$. I calculated this with my calculator. – Bobby H – 2018-02-09T10:33:39.477

Where does this question originate from? – Chip Hurst – 2018-02-09T16:14:42.063

Answers

8

$n_1 = 2331259$, $n_2 = 3776127$,

Obtained from this Mathematica code:

cf = Compile[{{m, _Integer}},
  Block[{n, a, b, p, counter = 0,result},
   result = ConstantArray[0, m];
   p = 1355297;
   n = 0;
   a = Mod[10^(5), p];
   b = 0;
   While[counter < m,
    n++;
    a = Mod[a 1000000, p];
    b = Mod[b - 54 , p];
    While[Mod[a + b - 46, 1355297] != 0,
     n++;
     a = Mod[a 1000000, p];
     b = Mod[b - 54 , p];
     ];
    counter++;
    result[[counter]] = n;
    ];
   result
   ],
  CompilationTarget -> "C"
  ];

cf[2]

{2331259, 3776127}

Henrik Schumacher

Posted 2018-02-09T09:51:28.943

Reputation: 85 430

Thanks Henrik I really appreciate this ! : D – Bobby H – 2018-02-09T10:37:47.890

You're welcome! – Henrik Schumacher – 2018-02-09T10:39:41.617

11

There is no need for a brute force search. There is also no need for compilation, which may run into the maximum compiled integer limit. A faster solution follows from a bit of theory. You can get the first 225000 solutions (up to $n\approx 306$ billion) in less than a second.

The original equation is ${\rm Mod}[10^{6n+5}-54n-46,p]=0$, where $p=1355297$.

Let $m=6n+5$ and write the equation as PowerMod[10,m,p]=Mod[9m+1,p].

The period of the cycle of PowerMod[10,x,p] for $x=1,2,3,...$ equals the period of the decimal expansion of $1/p$, for prime $p$. The length of the repeating decimal of $1/p$ is MultiplicativeOrder[10,p] which, in this case, equals $p-1$.

MultiplicativeOrder[10, 1355297]

1355296

These are all 1355296 distinct residues in the repeating cycle. This pre-calculation takes about 3/4 second.

residues = PowerMod[10, Range[1355296], 1355297]

The two modular equations are:

$m=i+j*(p-1)$, mod $p$, with $1\le i \le p-1$, and $j\ge 1$, from length-$(p-1)$ cycle of residues for PowerMod[10,m,p]

$9m+1=k*p+r_i$, mod $p$, with $0\le k$, from Mod[9m+1,p]=ri, the i'th residue.

Multiply the first equation by 9 and equate to give $a*j+b*k=c$, where $a=9*(p-1)$, $b=-p$, and $c=r_i-1-9*i$. Solve this linear Diophantine equation via ExtendedGCD[a,b].

ExtendedGCD[9(p-1),-p]={g,{u,v}}

{1, {301177, 2710591}}

Only the first term, $u=301177$, of the second part is required.

There are infinitely many solutions $\{j,k\}=\{u*c+b*q,v*c-a*q\}$, where $q\ge $0 and $a*u+b*v=1$ is found via ExtendendGCD[a,b]. The smallest solution occurs when q=Quotient[u*c,p]. The last step is to sort those solutions $m$ equivalent to 5, mod 6.

The first roughly quarter million solutions are found in about 1/4 second. The fastest of the current 3 answers was from @MichaelE2, where the first 10 solutions are found in about 0.68 s.

Block[{p = 1355297, i, u, uc},
   u = ExtendedGCD[9 (p - 1), -p][[2, 1]];
   AbsoluteTiming[
      i = Range[Length[residues]];
      uc = u*(residues[[i]] - 1 - 9 i);
      (Sort[Pick[#, Mod[#, 6], 5] &[i + (p - 1) (uc - p*Quotient[uc, p])]] - 5)/6
  ]]

{0.230856, {2331259, 3776127, 5366598, 5505709, 5652052, 7317951,..., 306133783114, 306135079824, 306136273333}}

Subsequent solutions follow by decreasing the integer q=Quotient[uc,p].

KennyColnago

Posted 2018-02-09T09:51:28.943

Reputation: 14 269

3Nice. Note that residues = NestList[Mod[10 #, 1355297] &, 10, Length@# - 1] &[Range[1355296]] is about 16 times faster than PowerMod, which makes the cost of pre-computing residues almost insignificant. (I figure PowerMod is advantageous when a single or sporadic values are needed.) – Michael E2 – 2018-02-24T19:36:21.490

@MichaelE2 Thanks for the tip here and before on slow PowerMod. I use it frequently, and will redefine it using your much faster NestList formulation. – KennyColnago – 2018-02-25T16:28:36.960

8

A more Mathematica way to do an exhaustive search:

pp = 1355297;
Pick[#,
 Mod[10^5 NestList[Mod[10^6 #, pp] &, 10^6, Length@# - 1] - (54 n + 46 /. n -> #), pp],
 0] &@ Range[10^7] // AbsoluteTiming

(*  {0.665031, {2331259, 3776127, 5366598, 5505709, 5652052, 7317951, 8306396, 8955772}} *)

The same applied to chunks, which quits after at least 2 solutions are found.

Last@NestWhile[
  Function[args,            (* args = {current range, current solutions *)
   With[{range = Range @@ args[[1]], sols = args[[2]]},
    With[{s = Flatten[{
         sols,
         Pick[range, 
          Mod[10^5 NestList[Mod[10^6 #, pp] &, 
              PowerMod[10^6, First@range, pp], 
              Length@range - 1] - (54 n + 46 /. n -> range),
           pp],
          0]
         }]},
     {args[[1]] + 10^6, s}  (* increment range *)
     ]]
   ],
  {{1, 10^6}, {}},          (* {initial range, initial solutions *)
  Length[#[[2]]] < 2 &,     (* min. number of solutions *)
  1,
  100                       (* MaxIterations *)
  ] // RepeatedTiming

(*  {0.27, {2331259, 3776127}}  *)

Somewhat surprisingly, it is faster than Henrik's compiled-to-C solution:

cf[2] // RepeatedTiming
(*  {0.283, {2331259, 3776127}}  *)

Remark: Disappointingly, PowerMod is slow, so I used NestList:

foo = NestList[Mod[10^6 #, pp] &, 10^6, Length@# - 1] &[Range[10^7]]; // AbsoluteTiming
(*  {0.480641, Null}  *)

murf = PowerMod[10^6, Range[10^7], pp]; // AbsoluteTiming
(*  {7.97349, Null}  *)

foo == murf
(*  True  *)

Michael E2

Posted 2018-02-09T09:51:28.943

Reputation: 190 928

Very interesting! I tried to Complie your Mathematica Pick[]-approach, hoping to speed it up, but didn't succeed. What's wrong with find = Compile[{{mr, _Integer , 1}, {pz, _Integer }}, Block[{}, Pick[mr, Mod[10^5 NestList[Mod[10^6 mr, pz] &, 10^6, Length[mr] - 1] - (54 mr + 46), pz ](*Mod*), 0] ] ]? – Ulrich Neumann – 2018-02-11T15:37:24.533

1

@UlrichNeumann Unfortunately, Pick is not compilable.

– Michael E2 – 2018-02-11T15:39:41.170

@ Michael E2: It's a pity,thanks. – Ulrich Neumann – 2018-02-11T15:48:50.023

7

How about this?

cf = Compile[{{max, _Integer}, {p, _Integer}, {j, _Integer}},
   Module[{list = ConstantArray[0, 0]},
    Do[
     If[
      PowerMod[10, 6 n + 5, p] - Mod[54 n + 46, p] == 0,
      AppendTo[list, n];
      If[Length[list] >= j, Break[]]
      ],
     {n, Range[1, max]}
     ];
    list
    ]
   ];

In[20]:= result = cf[10^8, 1355297, 2]

Out[20]= {2331259, 3776127}

Check the result:

In[21]:= Table[Mod[10^(6 n + 5) - 54 n - 46, 1355297], {n, result}]

Out[21]= {0, 0}

Sjoerd Smit

Posted 2018-02-09T09:51:28.943

Reputation: 15 418

Hmpf. You beat me by 31 seconds... =) – Henrik Schumacher – 2018-02-09T10:32:05.180

=). I'm also going to say that my use of PowerMod is quite clever here. – Sjoerd Smit – 2018-02-09T10:35:11.177

Nah, it isn't... Check the timings. ;o) But I actually was looking for something like PowerMod but did not find it for some reason... – Henrik Schumacher – 2018-02-09T10:35:51.743

Why not the simple and obvious list = {} rather than the more obscure list = ConstantArray[0, 0]? – m_goldberg – 2018-02-09T13:13:40.133

1I tried list = {}, but for some reason this coerces all elements added to the list to reals. ConstantArray[0, 0] was the easiest method I found to create an empty integer list. – Sjoerd Smit – 2018-02-09T14:02:02.170

You can also use list = Most@{0}. I don't claim that's less obscure, but I've seen others do it. – Michael E2 – 2018-02-09T14:04:13.277