Question

The problem is:

For a positive integer n, define f(n) as the least positive multiple of n that, written in base 10, uses only digits ≤ 2.

Thus f(2)=2, f(3)=12, f(7)=21, f(42)=210, f(89)=1121222.

---

To solve it in Mathematica, I wrote a function f which calculates f(n)/n :

f[n_] := Module[{i}, i = 1; 
While[Mod[FromDigits[IntegerDigits[i, 3]], n] != 0, i = i + 1]; 
Return[FromDigits[IntegerDigits[i, 3]]/n]]

The principle is simple: enumerate all number with 0, 1, 2 using ternary numeral system until one of those number is divided by n.

It correctly gives 11363107 for 1~100, and I tested for 1~1000 (calculation took roughly a minute, and gives 111427232491), so I started to calculate the answer of the problem.

However, this method is too slow. The computer has been calculating the answer for two hours and hasn’t finished computing.

How can I improve my code to calculate faster?

Answer 1

hammar’s comment makes it clear that the calculation time is disproportionately spent on values of n that are a multiple of 99. I would suggest finding an algorithm that targets those cases (I have left this as an exercise for the reader) and use Mathematica’s pattern matching to direct the calculation to the appropriate one.

f[n_Integer?Positive]/; Mod[n,99]==0  :=  (*  magic here *)
f[n_] := (* case for all other numbers *) Module[{i}, i = 1;
 While[Mod[FromDigits[IntegerDigits[i, 3]], n] != 0, i = i + 1];
 Return[FromDigits[IntegerDigits[i, 3]]/n]]

Incidentally, you can speed up the fast easy ones by doing it a slightly different way, but that is of course a second-order improvement. You could perhaps set the code up to use ff initially, breaking the While loop if i reaches a certain point, and then switching to the f function you have already provided. (Notice I’m returning n i not i here – that was just for illustrative purposes.)

ff[n_] := 
 Module[{i}, i = 1; While[Max[IntegerDigits[n i]] > 2, i++]; 
  Return[n i]]

Table[Timing[ff[n]], {n, 80, 90}]

{{0.000125, 1120}, {0.001151, 21222}, {0.001172, 22222}, {0.00059, 
  11122}, {0.000124, 2100}, {0.00007, 1020}, {0.000655, 
  12212}, {0.000125, 2001}, {0.000119, 2112}, {0.04202, 
  1121222}, {0.004291, 122220}}

This is at least a little faster than your version (reproduced below) for the short cases, but it’s much slower for the long cases.

Table[Timing[f[n]], {n, 80, 90}]

{{0.000318, 14}, {0.001225, 262}, {0.001363, 271}, {0.000706, 
 134}, {0.000358, 25}, {0.000185, 12}, {0.000934, 142}, {0.000316, 
 23}, {0.000447, 24}, {0.006628, 12598}, {0.002633, 1358}}