Optimization 如何更快地解决Euler项目问题303？

最重要的是：

对于正整数n，定义f（n）为n的最小正倍数，以10为底，仅使用数字≤ 二,

因此f（2）=2，f（3）=12，f（7）=21，f（42）=210，f（89）=1121222

---

为了在Mathematica中解决这个问题，我编写了一个函数

f

，它计算f（n）/n：

原理很简单：使用三元数制，用

0,1,2

枚举所有数字，直到其中一个数除以

n

它正确地给出了1~100的

11363107

，我测试了1~1000（计算大约需要一分钟，给出了

111427232491

），所以我开始计算问题的答案

然而，这种方法太慢了。计算机已经计算了两个小时的答案，还没有完成计算

---

如何改进代码以加快计算速度？

您可以做的一件简单的事情是将函数编译为

C

，并使其可并行化

Clear[f, fCC]
f[n_Integer] := f[n] = fCC[n]
fCC = Compile[{{n, _Integer}}, Module[{i = 1},
   While[Mod[FromDigits[IntegerDigits[i, 3]], n] != 0, i++];
   Return[FromDigits[IntegerDigits[i, 3]]]],
  Parallelization -> True, CompilationTarget -> "C"];

Total[ParallelTable[f[i]/i, {i, 1, 100}]] 
(* Returns 11363107 *)

问题是，最终您的整数将大于一个长整数，Mathematica将恢复为非编译的任意精度算术。（我不知道为什么Mathematica编译器不包含任意精度的C库…）

正如ShreevatsaR所评论的，如果您编写智能代码（并考虑数学问题），项目Euler问题通常设计为快速运行，但如果您想强行执行它，则需要花费很长时间。看。此外，在其他网站上发布破坏者也被认为是不好的形式

---

旁白：

您可以通过运行

In[1]:= test = Compile[{{n, _Integer}}, {n + 1, n - 1}];

In[2]:= test[2147483646]
Out[2]= {2147483647, 2147483645}

In[3]:= test[2147483647]
During evaluation of In[53]:= CompiledFunction::cfn: Numerical error encountered at instruction 1; proceeding with uncompiled evaluation. >>
Out[3]= {2147483648, 2147483646}

In[4]:= test[2147483648]
During evaluation of In[52]:= CompiledFunction::cfsa: Argument 2147483648 at position 1 should be a machine-size integer. >>
Out[4]= {2147483649, 2147483647}

---

哈马尔的评论清楚地表明，计算时间不成比例地花费在99的倍数

n

上。我建议找到一种针对这些情况的算法（我将此作为练习留给读者），并使用Mathematica的模式匹配将计算导向适当的算法

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

顺便说一句，你可以通过稍微不同的方式来加速快速简单的，但这当然是一个二阶改进。您可以将代码设置为最初使用

ff

，如果

i

达到某一点，则在

时中断
循环，然后切换到您已经提供的
f
功能。（注意我在这里返回的是
ni
而不是
I
——这只是为了说明。）

对于短案例，这至少比您的版本（复制如下）快一点，但对于长案例，这要慢得多

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}}

我相信一定有更好的方法来做到这一点，但这是我的灵感带给我的

下面的代码查找n1-10000的所有f[n]值，但最难的值除外，它恰好是n=9999。我们到那里时我会停止循环

ClearAll[f];
i3 = 1;
divNotFound = Range[10000]; 
While[Length[divNotFound] > 1, 
  i10 = FromDigits[IntegerDigits[i3++, 3]];
  divFound = Pick[divNotFound, Divisible[i10, divNotFound]];
  divNotFound = Complement[divNotFound, divFound];
  Scan[(f[#] = i10) &, divFound]
] // Timing

Divisible
可能对两个参数的列表都有效，我们在这里充分利用了这一点。整个程序大约需要8分钟

对于9999来说，需要一点思考。它在合理的时间内是不可强制执行的

设p为我们正在寻找的因子，T（仅由0、1和2组成）为p与9999相乘的结果，即

9999 P = T

然后

让P1，…PL是p的位数，Ti是T的位数，那么我们就有了


总和中的最后四个零当然来自10000的乘法。因此，TL+1，…，TL+4和PL-3，…，PL是相互补充的。如果前者仅包含0,1,2，则后者允许：

last4 = IntegerDigits[#][[-4 ;; -1]] & /@ (10000 - FromDigits /@ Tuples[{0, 1, 2}, 4])

==> {{0, 0, 0, 0}, {9, 9, 9, 9}, {9, 9, 9, 8}, {9, 9, 9, 0}, {9, 9, 8, 9}, 
     {9, 9, 8, 8}, {9, 9, 8, 0}, {9, 9, 7, 9}, ..., {7, 7, 7, 9}, {7, 7, 7, 8}}

只有81个允许设置，7、8、9和0（并非所有可能的组合）而不是10000个数字，速度增益为120倍

可以看出，P1-P4只能有三进制数字，即三进制数字和零的和。您可以看到，添加T5和P1不会产生结转。通过认识到P1不能为0（第一个数字必须是某物），可以获得进一步的减少，如果它是2乘以9999，则会导致T的结果中出现8或9（如果出现进位），这也是不允许的。那一定是1。P2-P4也可排除两个

由于P5=P1+T5，因此P5<4等于T5<3，与P6-P8相同。
由于P9=P5+T9，因此P9<6，与P10-P11相同

在所有这些情况下，添加不需要包括结转，因为它们不会发生（Pi+Ti总是<8）。如果L=16，则P12可能不是这样。在这种情况下，我们可以从最后4位的加法中得到一个结转。所以P12{295.37211133355557778}

事实上111133355557778 x 9999=11112222222

我们可以猜到这是

f[9]=12222

f[99]=1122222222

f[999]=1112222

该模式显然是1的数量随着每一步的增加而增加，连续2的数量随着4的增加而增加

13分钟，这超过了project Euler的1分钟限制。也许不久我会调查此事。
试试更聪明的办法

构建一个函数F（N），它找出可被N整除的{0，1，2}位的最小数

因此，对于给定的N，我们正在寻找的数字可以写成SUM=10^N*dn+10^（N-1）*dn-1。。。。10^1*d1+1*d0（其中di是数字的数字）

因此，您必须找出总和%N==0的数字
基本上，每一位数字与（10^i*di）%N之和成正比

我不会给出更多提示，但下一个提示是使用DP。试着找出如何使用DP来找出数字

< 1 > 10000之间的所有数字在C++中用1秒。（合计）

祝你好运。
提示：试着看看每个f（k）的值。只有最后几个需要很长时间才能计算，但您可能可以找到一种模式：）所有project Euler解决方案都应该在大约一分钟内运行
9999 P = T

P(10,000 - 1) = 10,000 P - P = T

 ==> 10,000 P = P + T

last4 = IntegerDigits[#][[-4 ;; -1]] & /@ (10000 - FromDigits /@ Tuples[{0, 1, 2}, 4])

==> {{0, 0, 0, 0}, {9, 9, 9, 9}, {9, 9, 9, 8}, {9, 9, 9, 0}, {9, 9, 8, 9}, 
     {9, 9, 8, 8}, {9, 9, 8, 0}, {9, 9, 7, 9}, ..., {7, 7, 7, 9}, {7, 7, 7, 8}}

Do[
  If[Max[IntegerDigits[
      9999 FromDigits[{1, 1, 1, 1, i5, i6, i7, i8, i9, i10, i11, i12}~
         Join~l4]]
     ] < 3, 
   Return[FromDigits[{1, 1, 1, 1, i5, i6, i7, i8, i9, i10, i11, i12}~Join~l4]]
  ], 
  {i5, 0, 3}, {i6, 0, 3}, {i7, 0, 3}, {i8, 0, 3}, {i9, 0, 5}, 
  {i10, 0, 5}, {i11, 0, 5}, {i12, 0, 6}, {l4,last4}
 ] // Timing

==> {295.372, 1111333355557778}