## 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.)

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

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


{2331259, 3776127}

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, 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].

3Nice. Note that residues = NestList[Mod[10 #, 1355297] &, 10, Length@# - 1] &[Range] 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[], sols = args[]},
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[] + 10^6, s}  (* increment range *)
]]
],
{{1, 10^6}, {}},          (* {initial range, initial solutions *)
Length[#[]] < 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 // 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  *)


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

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:= result = cf[10^8, 1355297, 2]

Out= {2331259, 3776127}


Check the result:

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

Out= {0, 0}


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