Find the minimum integer r such that $(10^r - 1)/37$ is an integer

12

4

I know Element[(10^r - 1)/37, Integers] tests the condition.

So what is the command that gives me the minimum integer value r such that the condition is true?

Gqqnbig

Posted 2014-12-29T06:59:49.183

Reputation: 285

Answers

17

Let us try to produce the solution without applying brute force, similar to mgamer's answer (that did not actually use Mathematica).

Reduce[Mod[10^r - 1, 37] == 0, r, Integers]
(* -> C[1] \[Element] Integers && C[1] >= 0 && r == 3 C[1] *)

We see that the value of r can in fact be any nonnegative multiple of 3. The result sought is then obvious by inspection.

Supposing that we are not willing even to allow for a little interpretation of the above result, or if the outcome is somewhat more complicated, and we want Mathematica to produce the answer directly. Then, we can use Minimize (note that this finds a global optimum symbolically, and so is different from both NMinimize and FindMinimum) on the (minimally rearranged) output of Reduce to find the value of the undetermined constant:

Minimize[{3 C[1], C[1] >= 0}, C[1], Integers]
(* -> {0, {C[1] -> 0}} *)

Minimum r is thus seen to be 0 if we are only restricting it to nonnegative values. Or, if we want it to be strictly positive,

Minimize[{3 C[1], C[1] > 0}, C[1], Integers]
(* -> {3, {C[1] -> 1}} *)

Minimum r is 3.

Note that Reduce and Minimize are limited in their capabilities, and therefore it may not be possible to use this approach in more difficult cases.

Oleksandr R.

Posted 2014-12-29T06:59:49.183

Reputation: 22 073

What does C[1] mean in the first output? The documentation says "C[1] is the default form for the first parameter or constant generated in representing the results of various symbolic computations. " So what is the first parameter? What's the default form? – Gqqnbig – 2014-12-29T20:15:22.917

1@LoveRight C[1] is Mathematica's way of writing an arbitrary constant. Here Reduce tells us that C[1] is any nonnegative integer. Then, we proceed to ask Minimize for a specific value of C[1] that minimizes r. – Oleksandr R. – 2014-12-30T01:00:00.283

2If there is a solution, it is periodic modulo EulerPhi[37]. Here's a solution that does not need Minimize: Min[r /. Solve[Mod[10^r - 1, 37] == 0 && 0 < r <= EulerPhi[37], r, Integers]]. – Chip Hurst – 2014-12-31T16:00:41.157

11

You are asking for a solution to the equation $10^r\equiv 1$, mod $n$, where in your particular case $n=37$. The multiplicative order is the smallest exponent $r$ such that $x^r\equiv 1$, mod $n$. The multiplicative order is given by the Mathematica command MultiplicativeOrder[x,n], and corresponds to the "Foo" you asked for in your comment to @mgamer. Hence, the solution is

MultiplicativeOrder[10,37]
(* 3 *)

The speed of this single command is at least 100 times faster than any other previously posted solution. For $n=739523387$ the result $r=369761693$ is returned in 0.00004 s on my machine.

KennyColnago

Posted 2014-12-29T06:59:49.183

Reputation: 14 269

I ignored this question at first because I thought, there's a built-in command for such a fundamental equation and someone must have already found it. (+1 of course.) – Michael E2 – 2015-01-01T18:45:32.367

So that's how Reduce is doing it. This is now, by far, the best answer here. – Mark Adler – 2015-01-02T01:12:33.347

10

Find the first positive integer that satisfies the condition:

NestWhile[# + 1 &, 1, ! Element[(10^# - 1)/37, Integers] &]
3

Or

r = 0; NestWhile[Element[(10^(++r) - 1)/37, Integers] &, False, Not]; r
3

Or

Block[{r = 1},
  While[! Element[(10^r++ - 1)/37, Integers]];
  r - 1]
3

Karsten 7.

Posted 2014-12-29T06:59:49.183

Reputation: 26 728

This solution uses traditional while loops and works. It doesn't use math knowledge and is much slower than Oleksandr R.'s solution. But the style of writing a loop is worth learning. Thanks. – Gqqnbig – 2015-01-01T07:48:34.820

6

Instead of a brute-force approach on larger and larger powers of ten, this constructs the multiplier digit by digit by dividing from the bottom up. There is only one choice for each digit. This is much faster than the brute-force approach when the number of digits is large.

nines[n_ /; n > 2 && OddQ[n] && ! Divisible[n, 5]] :=
 Block[{x, r = 0, k = 1},
  x = Ordering[Mod[n Range[0, 9], 10]] - 1;
  While[r = Quotient[r + n x[[10 - Mod[r, 10]]], 10]; r != 0, k++];
  k
 ]

nines[37]
3
nines[19]
18
nines[343]
294
Divisible[10^294 - 1, 343]
True
Timing[nines[582749]]
{0.975075, 276030}
Timing[NestWhile[# + 1 &, 1, ! Divisible[10^# - 1, 582749] &]]
{219.193427, 276030}
Divisible[10^276030 - 1, 582749]
True

While that was satisfying, a brute-force approach with PowerMod turns out to be faster, which also avoids working directly with giant powers of ten. (Inspired by Chip Hurst's answer.)

Timing[NestWhile[# + 1 &, 1, PowerMod[10, #, 582749] != 1 &]]
{0.485487, 276030}

This could be combined with Chip Hurst's answer, where that approach is used when n has a primitive root (which is faster still), or this brute force with PowerMod is used when it does not.

Going back to the direct solution, that should be blindingly fast in C, since it works on machine integers. However I could not get Compile[] to generate efficient code for this for some reason. So here is the algorithm using CompileLibrary[] with the C code written manually:

Needs["CCompilerDriver`"]

nineslib = CreateLibrary["#include \"WolframLibrary.h\"
   DLLEXPORT mint WolframLibrary_getVersion( ) {
    return WolframLibraryVersion;
   }
   DLLEXPORT int WolframLibrary_initialize( WolframLibraryData libData) {
    return 0;
   }
   DLLEXPORT void WolframLibrary_uninitialize( WolframLibraryData libData) {
    return;
   }
   DLLEXPORT int nines(WolframLibraryData libData,
            mint Argc, MArgument *Args, MArgument Res) {
       int k, x[10];
       mint n, p, r = 0;
       n = MArgument_getInteger(Args[0]);
       if (n > 2 && (n & 1) && n % 5) {
           for (k = 0; k < 10; k++)
               x[9 - (n * k) % 10] = k;
           p = 0;
           do {
               p = (p + n * x[p % 10]) / 10;
               r++;
           } while (p);
       }
       MArgument_setInteger(Res, r);
       return LIBRARY_NO_ERROR;
   }", "nines"];

ninesc = LibraryFunctionLoad[nineslib, "nines", {Integer}, Integer];

Trying it out:

ninesc[343]
294
Timing[ninesc[582749]]
{0.002242, 276030}

Yep, blindingly fast. And it seems to be quite a bit faster than the primitive root approach, where there is a primitive root.

Timing[ninesc[739523387]]
{3.050735, 369761693}
Timing[MinExponent[{10, 1, 739523387}, r]]
Solving Mod[224945292 r,369761693]==0

{100.140380, r == 369761693}

Mark Adler

Posted 2014-12-29T06:59:49.183

Reputation: 4 739

This solution involves much more advanced methods. I really need to take some time to learn it, especially the inter-operation with other language. Thanks. – Gqqnbig – 2015-01-01T07:56:57.253

Actually it's really simple. 37 times q gives a sequence of 9's. What would you multiply 7 by to get a 9 in the last digit? 7x7 = 49. So the last digit of q is 7. 7x37 = 259. The next digit in q times 7 plus the 5 in 259 has to give the next 9. So what times 7 ends in a 4? 7x2 = 14. 2x37 = 74. 25+74=99. So for q=27, we have 999. Done! (If we didn't get a 9 in the third digit, then we would just keep going, picking one more digit of the multiplier to give another 9 in that digit of the product. Until we have all 9's.) – Mark Adler – 2015-01-01T08:25:05.107

The solution using MultiplicativeOrder is the one using "more advanced methods". It is much faster than my constructive approach. Which was already pretty fast. – Mark Adler – 2015-01-02T01:15:43.663

5

From $(10^r-1)/37=n$ it follows $10^r=37n+1$ The first $n$ such that $37n+1$ is a power of 10 is 27, since $37*27+1=1000$. So $(10^3-1)/37=3$. So r=3

mgamer

Posted 2014-12-29T06:59:49.183

Reputation: 5 271

Yes. This process is clear. But I'm seeking a Mathematica command to do this. For example Foo[Element[(10^r - 1)/37, Integers], r, r$\in$Integers]. What is the Foo? – Gqqnbig – 2014-12-29T07:49:19.293

5

We can reduce your problem to solving a linear equation modulo an integer. That way we can avoid functions like Minimize.

If a primitive root exists for the modulus, we can take discrete logarithms of both sides and easily solve for r. This following code finds the smallest positive r such that (b^r - c)/mod ∈ Integers.

HasPrimitiveRootQ[n_Integer?Positive] := 
  n < 8 || (OddQ[n] && PrimePowerQ[n]) || (OddQ[n/2] && PrimePowerQ[n/2])
HasPrimitiveRootQ[_] = False;

MinExponent[{b_, c_, mod_?HasPrimitiveRootQ}, r_] := Module[{g,dlhs,drhs,phi,gcd,sol},
    g = PrimitiveRoot[mod];
    dlhs = MultiplicativeOrder[g, mod, {b}];
    drhs = MultiplicativeOrder[g, mod, {c}];
    phi = EulerPhi[mod];
    gcd = GCD[dlhs, drhs, phi];

    {dlhs, drhs, phi} /= gcd;

    Print["Solving ", Mod[dlhs r, phi] == Mod[drhs, phi]];

    r == Mod[drhs*PowerMod[dlhs, -1, phi], phi, 1]
]

And your example reduces to solving a linear equation mod 3:

MinExponent[{10, 1, 37}, r]

Solving Mod[2r, 3] == 0

r == 3

Chip Hurst

Posted 2014-12-29T06:59:49.183

Reputation: 29 735

Very nice (and mention upvote so this has enough characters). – Daniel Lichtblau – 2014-12-29T16:12:22.193

1Doesn't always work. HasPrimitiveRootQ[582749] returns False, but 582749 has a solution. (See my answer.) – Mark Adler – 2014-12-29T17:29:09.420

@MarkAdler right, which is why I have the disclaimer "If a primitive root exists for the modulus". – Chip Hurst – 2014-12-29T17:45:55.183

Though it gave me an idea for a better approach ... – Mark Adler – 2014-12-29T17:46:11.443

4

Because the domain is described as Integers, and because negative integers cannot satisfy the condition, the first non negative integer that satisfy the condition is 0, as the following expression can prove if necessary.

NestWhile[# + 1 &, 0, ! IntegerQ[(10^# - 1)/37] &]
(* 0 *)

If the domain is instead positive Integers, a sligtly modification is enough:

NestWhile[# + 1 &, 1, ! IntegerQ[(10^# - 1)/37] &]
(* 3 *)

An easy to read command that find the first integers satisfying the condition, and the first of them, is:

Position[Range[100], r_ /; IntegerQ[(10^r - 1)/37]] // Flatten
First@%

Result:

{3, 6, 9, 12, 15, 18, 21, 24, 27, 30, 33, 36, 39, 42, 45, 48, 51, 54, \
57, 60, 63, 66, 69, 72, 75, 78, 81, 84, 87, 90, 93, 96, 99}

3

A minor modification for Mathematica 10 is:

FirstPosition[Range[100], r_ /; IntegerQ[(10^r - 1)/37]] // First

Both last expressions require a guess of how many integers we have to test before finding an integer satisfying the condition, this is the meaning of Range[100].

unlikely

Posted 2014-12-29T06:59:49.183

Reputation: 6 755

3

Simple brute force :

r = 1;
While[Not@IntegerQ[(10^r - 1)/37], r++]
r

returns 3.

A.G.

Posted 2014-12-29T06:59:49.183

Reputation: 3 639