12
$\begingroup$

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?

$\endgroup$
17
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ 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? $\endgroup$ – Gqqnbig Dec 29 '14 at 20:15
  • 1
    $\begingroup$ @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. $\endgroup$ – Oleksandr R. Dec 30 '14 at 1:00
  • 2
    $\begingroup$ If 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]]. $\endgroup$ – Chip Hurst Dec 31 '14 at 16:00
11
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ 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.) $\endgroup$ – Michael E2 Jan 1 '15 at 18:45
  • $\begingroup$ So that's how Reduce is doing it. This is now, by far, the best answer here. $\endgroup$ – Mark Adler Jan 2 '15 at 1:12
10
$\begingroup$

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
$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Gqqnbig Jan 1 '15 at 7:48
6
$\begingroup$

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}
$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Gqqnbig Jan 1 '15 at 7:56
  • $\begingroup$ 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.) $\endgroup$ – Mark Adler Jan 1 '15 at 8:25
  • $\begingroup$ The solution using MultiplicativeOrder is the one using "more advanced methods". It is much faster than my constructive approach. Which was already pretty fast. $\endgroup$ – Mark Adler Jan 2 '15 at 1:15
5
$\begingroup$

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

$\endgroup$
  • $\begingroup$ 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? $\endgroup$ – Gqqnbig Dec 29 '14 at 7:49
5
$\begingroup$

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
$\endgroup$
  • $\begingroup$ Very nice (and mention upvote so this has enough characters). $\endgroup$ – Daniel Lichtblau Dec 29 '14 at 16:12
  • 1
    $\begingroup$ Doesn't always work. HasPrimitiveRootQ[582749] returns False, but 582749 has a solution. (See my answer.) $\endgroup$ – Mark Adler Dec 29 '14 at 17:29
  • $\begingroup$ @MarkAdler right, which is why I have the disclaimer "If a primitive root exists for the modulus". $\endgroup$ – Chip Hurst Dec 29 '14 at 17:45
  • $\begingroup$ Though it gave me an idea for a better approach ... $\endgroup$ – Mark Adler Dec 29 '14 at 17:46
4
$\begingroup$

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

$\endgroup$
3
$\begingroup$

Simple brute force :

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

returns 3.

$\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.