P41: 全数字的素数

Pandigital prime

如果一个 位数恰好使用了 至 每个数字各一次, 我们就称其为全数字的.

例如, 就是一个 位全数字数, 同时它恰好也是一个素数.

最大的全数字的素数是多少?

就是个 位数, 因为当 为 或 时, 无论怎么排都能被 整除.

事实上 里就俩合法的位数, 穷举就行.

Max[FromDigits /@ Select[Permutations[Range[7]], PrimeQ@FromDigits@#&]]

P42: 编码三角形数

Coded triangle numbers

三角形数序列的第 n 项由公式 给出; 因此前十个三角形数是:

将一个单词的每个字母分别转化为其在字母表中的顺序并相加, 我们可以计算出一个单词的值.

例如, 单词 SKY 的值就是 .

如果一个单词的值是一个三角形数, 我们就称这个单词为三角形单词.

在这个 16K 的文本文件 words.txt 中包含有将近两千个常用英文单词, 这其中有多少个三角形单词?

就是那道求姓名值的变体, 直接判断判别式是否是整数就行.

$$\begin{aligned} &t = \frac{1}{2}n(n + 1)\ &n = - \frac{1}{2}\left( {1 \pm \sqrt {8t + 1} } \right), \sqrt {8t + 1} \in N \end{aligned} $$

我喜欢这个出题方式, 直接 Import 它的网页就行.

data = Import["https://projecteuler.net/project/resources/p042_words.txt", "CSV"][[1]];
Count[Sqrt[Total /@ (ToCharacterCode@data - 64) * 8 + 1], _Integer]

P43: 子串的可整除性

Sub-string divisibility

1406357289 是一个 0 至 9 全数字数, 因为它由 0 到 9 这十个数字排列而成;

但除此之外, 它还有一个有趣的性质: 子串的可整除性.

记 d1 是它的第一个数字, d2 是第二个数字, 依此类推, 我们注意到:

d2d3d4=406 能被 2 整除 d3d4d5=063 能被 3 整除 d4d5d6=635 能被 5 整除 d5d6d7=357 能被 7 整除 d6d7d8=572 能被 11 整除 d7d8d9=728 能被 13 整除 d8d9d10=289 能被 17 整除

找出所有满足同样性质的 0 至 9 全数字数, 并求它们的和.

有点复杂, 十亿级别穷举肯定是不行的了.

要找一种方法来把这 7 个整除集合连起来咯. 比如除 17 的集合找到了 289, 然后除 13 的集合就要找 X28, 比如 728, 然后除 11 的里再找....

就是构造一个函数 numLink, 取一个数给他的头上加数并检测合法性. 最后全部全过程试完还合法的就是最终的结果了.

numLink[u:{__List},d_]:=Level[numLink[#,d]&/@u,{2}];
numLink[u_,d_]:=Select[If[u=={},Permutations[Range[0,9],{3}],
u~Prepend~#&/@Range[0,9]~Complement~u],FromDigits[#~Take~3]~Divisible~d&];
Total[FromDigits/@Fold[numLink,{},{17,13,11,7,5,3,2,1}]]

P44: 五边形数

Pentagon numbers

五边形数由公式 生成. 前十个五边形数是:

可以看出 .

然而, 它们的差 并不是五边形数.

在所有和差均为五边形数的五边形数对 Pj 和 Pk 中, 找出使 D = |Pk − Pj | 最小的一对; 此时 D 的值是多少?

不穷举的话就是解这种方程.

我反正不会解. 所以还是穷举吧. 最后还是用了编译...

还有一种思路就是先取集合然后组合判定, 我本来也是这么写的, 但是没跑出来.

后来我看题解, 别人 python 写 combinations 秒出, 我写 Subsets 就卡题了, 垃圾商业软件....

第二道了, 这题当初我用 Haskell 也是一点事情也没有...

特么 MemberQ,IntegerQ 也是莫名其妙的慢...

第二种写法比第一种写法快 5 倍你敢信....

a = IntegerQ@Sqrt[#] & /@ Range[10000]; // RepeatedTiming
b = FractionalPart@Sqrt[# + .0] == 0 & /@ Range[10000]; // RepeatedTiming
a == b

P = # (3 # - 1.0) / 2&;
fooQ = FractionalPart[(Sqrt[24# + 1.] + 1) / 6] == 0&;
Compile[{}, Do[If[fooQ[P[i] - P[j]] && fooQ[P[i] + P[j]],
Return[P[i] - P[j]]], {i, 3000}, {j, (1 + Sqrt[1 + 6 i (3 i - 1.0)]) / 6}],
CompilationOptions -> {"InlineExternalDefinitions" -> True}][]

P45: 三角形数, 五边形数和六角形数

Triangular, pentagonal, and hexagonal

三角形数, 五边形数和六角形数分别由以下公式给出:

三角形数 Tn=n(n+1)/2 1, 3, 6, 10, 15, … 五边形数 Pn=n(3n−1)/2 1, 5, 12, 22, 35, … 六边形数 Hn=n(2n−1) 1, 6, 15, 28, 45, … 可以验证, T285 = P165 = H143 = 40755.

找出下一个同时是三角形数, 五边形数和六角形数的数.

那就... 求仨集合交集呗... 穷举一下, 记得大规模赋值用 With.

幸好凑出来了, 要是没凑出来就要分析解方程了...

With[{r=Range@1*^6},Intersection@@Through[{# (#+1)/2&,# (3#-1)/2&,# (2#-1)&}[r]]]

P46: 哥德巴赫的另一个猜想

Goldbach's other conjecture

克里斯蒂安 · 哥德巴赫曾经猜想, 每个奇合数可以写成一个素数和一个平方的两倍之和.

最终这个猜想被推翻了.

最小的不能写成一个素数和一个平方的两倍之和的奇合数是多少?

Table[IntegerQ@Sqrt[(n - NextPrime[n]) / 2], {n, 1, 10000}]

......

嗯, 我一定没吃药... 题目都看错了...

$$\begin{aligned} c &= p + 2{r^2}\ r &= \sqrt {\fracNaN{2}} \in N \end{aligned} $$

穷举所有的素数不是最近的素数...

1-9999 找到 3 个反例, 取第二个, 为啥...

因为第一个不是 1 吗.

......

等会儿我在干嘛, 我干嘛写 Table, 怪不得这么慢, 这种找第一个的题不应该写 NestWhile 吗...

啥, 你说循环? 我们是高逼格的函数式编程, 用了循环还怎么高冷的装逼...

除非要用到编译否则我就不写循环. NestWhile 写起来不比循环爽吗...

2# - 1& /@ Position[Or@@@Table[IntegerQ /@ Sqrt[(n - Prime@Range@PrimePi[n]) / 2], {n, 1, 9999, 2}], False]

P47: 不同的质因数

Distinct primes factors

首次出现连续两个数均有两个不同的质因数是在:

首次出现连续三个数均有三个不同的质因数是在:

首次出现连续四个数均有四个不同的质因数时, 其中的第一个数是多少?

素分解...F1 秒了.....

你问 NestWhile 这么搞和 While 循环到底有啥区别么, 好像确实没啥区别....

主要是循环没有返回值很蛋疼好不好, 而且还要初始化....

NestWhile[# + 1&, 1, Length /@ FactorInteger[{#, # + 1, # + 2, # + 3}] != {4, 4, 4, 4}&]

P48: 自幂

Self powers

十项的自幂级数求和为 .

求如下一千项的自幂级数求和的最后 位数字: .

快速幂模, F1 秒之....

Sum[PowerMod[n, n, 10^10], {i, 1, 1000}]

P49: 素数重排

Prime permutations

公差为 的三项等差序列 在两个方面非常特别:

• 其一: 每一项都是素数;
• 其二: 两两都是重新排列的关系.

一位素数, 两位素数和三位素数都无法构成满足这些性质的数列, 但存在另一个由四位素数构成的递增序列也满足这些性质.

将这个数列的三项连接起来得到的 位数是多少?

四位素数好像不多的样子, 穷举一下吧. 重排素数这玩意儿我前面是不是写过来着...

Equal@@Differences@Sort@#& 可以用来对任意元数组进行等差检验

loop = FromDigits /@ Permutations[IntegerDigits[#], {4}]& /@ Table[Prime@i, {i, 1, PrimePi[10^4]}];
pair = Sort /@ Select[Select[#, 1000 <= # && PrimeQ[#]&]& /@ loop, Length@# >= 3&];
Union@Select[Flatten[Subsets[#, {3}]& /@ pair, 1], Equal@@Differences@#&]

P50: 连续素数的和

Consecutive prime sum

素数 可以写成六个连续素数的和:

在小于一百的素数中, 能够被写成最多的连续素数的和.

在小于一千的素数中, 能够被写成最多的连续素数的和, 共包含连续 个素数.

在小于一百万的素数中, 哪个素数能够被写成最多的连续素数的和?

穷举穷举

Partition[Prime~Array~1000, n, 1] 生成一个 n 元的等差数列

Select 那些求和之后还是素数的, 并取这里面最小的那个.

a*^b 是 a×10^b 的语法糖...

还有一种思路就是从 开始加, 加到 万为止, Accumulate 并且选出里面是质数的

然后 开始... 开始.... 其实差不多...

sum = Min@Select[Total /@ Partition[Prime ~ Array ~ 1000, #, 1], PrimeQ]&;
Last@Cases[Array[fooQ, 20, NestWhile[# + 2&, 501, sum[#] < 1*^6&]], a_ /; a < 1*^6]

---

连续计时 14 分 36 秒...

好像没啥难题啊, 还有好多水题, 用时竟然变多了...