7
$\begingroup$

Hi guys and guysettes,

The little Mathematica I've been using/seen so far, it seems to be all about neat "one-liners" using the underlying functions and working with lists & maps to solve issues, and very little looping and down and dirty coding.

So, when I attempt to do something like this, I get extremely inefficient code (yes, I'm relying on one explicit loop, though): (The task is to find the lowest value that is evenly divisible by 1 through 20)

results = {1}; i = 0;
While[Total[results] != 0,
 i++;
 results = Mod[i, #] &  /@ Range[1, 20];
 ]
i

..which takes about 8000 seconds to complete. Had I used another language, I would naturally had an inner-loop that breaks after the first "failing" 'Mod', but here I tried to use what I thought to be more of a "Mathematica way" and the results are horrible. So, I'm asking for advice on how you would construct a brute-force way of dealing with this?

For comparison, creating a similar way to solve the problem in Python, I got it to complete in about 1000 Seconds. Creating an "early-exit" solution without using unecessary lists for results, (the way I would normally code), it got down to 120 seconds.

Improve this question
$\endgroup$
8
  • 10
    $\begingroup$ One could of course be clever instead of relying on brute-force searching: LCM @@ Range[20] $\endgroup$
    – J. M.'s persistent exhaustion ♦
    Nov 9, 2012 at 9:48
  • 6
    $\begingroup$ You pay a huge penalty because values in Mathematica are untyped (as distinct from Python, which requires all values to have a definite type). Compilation can improve matters substantially if machine numbers are sufficient. There is nothing wrong with using the right tool for the job, though, and Mathematica is not always the answer. It does however obtain the result in this case rather quickly on its own terms: Solve[i \[Element] Integers && And @@ (Mod[i, #] == 0 & /@ Range[20]), i] finds the answer of 232792560 in essentially no measurable time. $\endgroup$
    – Oleksandr R.
    Nov 9, 2012 at 9:54
  • $\begingroup$ @J.M. while of course using a builtin is the best option when possible, I feel that this question relates more to the situation whereby that's not the case, so perhaps your first formulation was more appropriate? Of course Solve is not a general solution either but it can quite often find an approach better than brute force (given a well-posed problem), so is at least somewhat generalizable. $\endgroup$
    – Oleksandr R.
    Nov 9, 2012 at 10:13
  • $\begingroup$ @Oleksandr, that would not have been easily generalizable either; I was using FactorInteger[] there... $\endgroup$
    – J. M.'s persistent exhaustion ♦
    Nov 9, 2012 at 10:24
  • $\begingroup$ @J.M, as Oleksandr R. pointed out, I was asking about brute-force approach in Mathematica for a reason (should Mathematica be used in these cases or am I doing something very wrong?). $\endgroup$
    – JanneK
    Nov 9, 2012 at 12:47

3 Answers 3

Reset to default
8
$\begingroup$

The question invites us to perform the computation in steps: the presence of Range[20] suggests--and indeed truly involves--20 loops.

Each loop effectively computes the least common multiple (lcm) of two integers. In the spirit of the example offered in the question, here's an implementation of the inefficient brute force (sieve) method, without any break to terminate the testing. It has also been made general-purpose to handle negative integers. This procedure lays out multiples of the larger of the two arguments, tests them all for divisibility by the smaller (that's the inefficient part), and returns the first such one.

lcm[a_Integer, b_Integer] := 
 With[{n = Max[Abs[a], Abs[b]], m = Min[Abs[a], Abs[b]]},
  Ordering[Mod[Range[n, m n, n], m], 1] n // First]

(Purists may object that lcm[0, n] returns n rather than 0. That's intentional: we seek the smallest strictly positive common multiple of the arguments.)

The natural Mathematica construct for iterated looping is the family of Fold and Nest operations. Let's use this to extend lcm to more than two arguments: 

lcm[n_Integer, m___] := Fold[lcm, Abs[n], {m}]

(The presence of Abs assures a correct result even when just one argument is used.) The command lcm @@ Range[20] instantly returns the desired value, $232792560$. (Well, I exaggerate slightly: the absolute execution time is really 210 microseconds.)

As a test of efficiency, do a brute-force search through $7.12 \times 10^{432}$ values:

AbsoluteTiming[lcm @@ Range[1000]]

{0.2652005, 712......520000}

Improve this answer
$\endgroup$
2
  • 1
    $\begingroup$ I want to thank you all for such great comments/answers to what might have been a somewhat fuzzy question to begin with. I have a lot to learn on the subject, and you have been much helpful! $\endgroup$
    – JanneK
    Nov 9, 2012 at 19:05
  • $\begingroup$ +1 but I still like lcm = Fold[#/#2 /. _~_~x_ | _ :> # x &, 1, {##}] & better, and it's a lot faster too. :^) $\endgroup$
    – Mr.Wizard
    Nov 10, 2012 at 8:54
6
$\begingroup$

I would use something like this:

f[m_] := Module[{n = 1},
  While[i = m; ++n; While[i > 1 && Mod[n, i--] == 0]; i > 1];
  n];

f[20]

It can be compiled:

fc = Compile[{{m, _Integer}},
  Block[{i = 0, n = 1},
   While[i = m; ++n; While[i > 1 && Mod[n, i--] == 0]; i > 1]; n]];

fc[20]

The compiled version runs in about 25 seconds here.

Improve this answer
$\endgroup$
5
  • $\begingroup$ Thanks for the suggestion. The style in this answer is exactly what I was trying to avoid, though (might as well use C). However, I tried compiling the original solution and it became over 20 times faster. That's a good sign. $\endgroup$
    – JanneK
    Nov 9, 2012 at 13:28
  • $\begingroup$ @JanneK. MMA (oops Mathematica) has many advantages. With Compile you can get the best of both worlds. If you add "CompilationTarget" -> "C" to Compile you will in fact get C performance. $\endgroup$
    – Ajasja
    Nov 9, 2012 at 15:25
  • 2
    $\begingroup$ @JanneK, FWIW, the "Mathematica way" to write your algorithm would be to use the Listable attribute of Mod (which will be faster than mapping Mod over the list): i = 1; With[{r = Range[20]}, While[Total[Mod[++i, r]] != 0]]; i $\endgroup$
    – Simon Woods
    Nov 9, 2012 at 15:30
  • 2
    $\begingroup$ To be honest though, if you want to improve the efficiency of this sort of brute force approach in Mathematica, Compile is often the best way to go, and if you're compiling then you should do the same sort of things you would do in C, like bailing out of loops early. $\endgroup$
    – Simon Woods
    Nov 9, 2012 at 15:30
  • $\begingroup$ @SimonWoods, about bailing out early: I actually tried something like If[Length[TakeWhile[Range[], Mod[i, #&]...]] == 20].. But it turned out to be even slower than the presented method. Thanks for bringing up the Listable attribute. I will keep this mind in the future before using Map $\endgroup$
    – JanneK
    Nov 9, 2012 at 16:57
1
$\begingroup$

This fairly minor modification to JanneK's brute force method reduces the execution to something well below 8000 seconds. 

smallest[n_Integer /; n > 1] := 
   Module[{d, i = n, r = Range[n]}, 
     Quiet@While[d = Divisors[i]; Check[d[[;; n]] != r, True], i += n]; 
     i]

Timing@smallest[20] (* ==> {215.772, 232792560} *)
Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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