# P21: 亲和数

Amicable numbers

的所有真因数(小于 且整除 的正整数)之和. 如果 , 且 , 那么 构成一个亲和数对, 被称为亲和数.

例如, 的真因数包括 , 因此 ; 而 的真因数包括 , 因此 .

求所有小于 的亲和数的和.

我不喜欢这道题, 因为里面的定义和 Mathematica 里的定义相冲.

不然可以写的更短一些. find 用来找出亲和数, 然后剃掉完全数.

find = Function[n, DivisorSigma[1, n] - n];
Total@Complement[Select[Range[10^4], find[find[#]] == #&], PerfectNumber[{1, 2, 3, 4}]]

# P22: 姓名得分

Names scores

在这个 46K 的文本文件 names.txt 中包含了五千多个姓名.首先将它们按照字母序排列, 然后计算出每个姓名的字母值, 乘以它在按字母顺序排列后的位置, 以计算出姓名得分.

例如, 按照字母序排列后, 位于第 位的姓名 COLIN 的字母值是 .

因此, COLIN 的姓名得分是 .

文件中所有姓名的姓名得分之和是多少?

真心不知道这个是什么鬼格式, 只能手动转化成列表了. 复习下 URLExecute 操作.

字母值正好是 ASCII 码减去 64. 介绍下内积操作 Inner.

Inner 作用于两个对齐的向量, 大概就是取出两个元素, 先使用前面那种算子运算, 然后全部算完后用后面那种算子表示.

Plus 算子就把最后结果加起来, List 算子的话就能变成一个列表.

input = URLExecute["https://projecteuler.net/project/resources/p022_names.txt"];
data = Sort@ImportString[StringReplace[input, {"\"" -> "", "," -> " "}], {"Text", "Words"}];
Inner[Times, Plus@@@(ToCharacterCode /@ data - 64), Range[Length@data], Plus]

# P23: 非盈数之和

Non-abundant sums

完全数是指真因数之和等于自身的那些数.

例如, 的真因数之和为 , 因此 是一个完全数.

如果一个数的真因数之和小于 , 那么 被称为亏数, 反之则被称为盈数.

由于 是最小的盈数, 它的真因数之和为 , 所以最小的能够表示成两个盈数之和的数是 .

通过数学分析可以得出, 所有大于 的数都可以被写成两个盈数的和; 尽管我们知道最大的不能被写成两个盈数的和的数要小于这个值, 但这是通过分析所能得到的最好上界.

找出所有不能被写成两个盈数之和的正整数, 并求它们的和.

啊哈, 又要用到 DivisorSigma 了, 这次满足 DivisorSigma[1, n] - n > n 的叫做盈数.

然后上界他给了, 那就直接 Select. 俩盈数之和, 那就 Tuples[list, 2] 穷举所有组合然后 Total 求和.

但是, 他求的是不能表示的那些数, 那就对 28123 个数求补集 Complement, 最后还要求和.

很好奇 28123 这个数是怎么来的, 只能看出这是个质数, 我证了下只能证明两个盈数之和还是盈数, 所以可能是用某种筛法证出来的.

AbundantNumList = Select[Range@28123, DivisorSigma[1, #] > 2#&];
Total@Complement[Range@28123, DeleteDuplicates[Total /@ Tuples[AbundantNumList, 2]]]

# P24: 字典序排列

Lexicographic permutations

排列指的是将一组物体进行有顺序的放置.

例如, 是数字 的一个排列.如果把所有排列按照数字大小或字母先后进行排序, 我们称之为字典序排列.

的字典序排列是:

数字 的字典序排列中第一百万位的排列是什么?

这个 F1 可能搞不定, 不过 Mathematica 用的多的话是能知道 Permutations 给出的是字典序的.

Permutations[Range[0, 9]][[1000000]]

# P25: 一千位斐波那契数

1000-digit Fibonacci number

斐波那契数列是按如下递归关系定义的数列:

\begin{aligned} {F_1}&= 1 \\ {F_2}&= 1 \\ {F_n}&= {F_{n - 1}}+{F_{n - 2}} \end{aligned}

第一个有三位数字的项是第 .

在斐波那契数列中, 第一个有 位数字的是第几项?

还记得 NestWhile 吗? 又用到了哦.

然后我被坑了一下, 想了半天, 发现 1000 位数10^999.

NestWhile[# + 1&, 1, Fibonacci[#] < 10^999&]

# P26: 倒数的循环节

Reciprocal cycles

单位分数指分子为 1 的分数.分母为 2 至 10 的单位分数的十进制表示如下所示:

1/2 = 0.5
1/3 = 0.(3)
1/4 = 0.25
1/5 = 0.2
1/6 = 0.1(6)
1/7 = 0.(142857)
1/8 = 0.125
1/9 = 0.(1)
1/10 = 0.1

这里 0.1(6) 表示 0.166666…, 括号内表示有一位循环节.可以看出, 1/7 有六位循环节.

找出正整数 内倒数的十进制表示小数部分有最长的循环节.

RealDigits 能给出循环小数, 不过不能直接给出循环节. 循环部分会由列表给出.

所以可以用模式匹配删掉不是列表的部分. 然后剩下的就是循环节啦.

我好像又无视了小于号 233333, 幸好 1000 没有循环节.

looped = Cases[RealDigits[1 / #][[1]], _List]&;
Max[Length /@ Flatten[Table[looped @i, {i, 1, 1000}], 1]]

# P27: 二次素数生成多项式

Quadratic primes

欧拉发现了这个著名的二次多项式:

对于连续的整数 , 这个二次多项式生成了 个素数.

然而, 当 时, 能够被 整除, 同时显然当 时, 也能被 整除.

随后, 另一个神奇的多项式 被发现了, 对于连续的整数 , 它生成了 个素数.这个多项式的系数 的乘积为 .

考虑以下形式的二次多项式:

, 满足 , 其中 的绝对值.

例如: 以及

这其中存在某个二次多项式能够对从 开始尽可能多的连续整数 都生成素数, 求其系数 的乘积.

穷举吗, 可是有 400 万种组合啊... 好吧我承认卡题了...

然后做完下面的题回过头来看, MDZZ.

这俩产生的素数个数相同啊, 都是 个啊, 欧拉找的那个是 成立的, 然后平移 格下就得到了右式

所以, 其实问的就是, 平移多少格正好生成 还生成尽可能多的素数. 手算都可以啊, 水题.

\begin{aligned} \left({n - k} \right)^2 + \left({n - k}\right) + 41 &= 0,0 < k < 40 \\ {n^2} + \left( {1 - 2k} \right)n + \left({k^2 - k + 41} \right) &= 0\\ \left| {k^2 - k + 41} \right| &< 1000\\ k \leqslant \left\lfloor{\frac{1 + \sqrt {3837} }{2}} \right\rfloor &= 31 \end{aligned}

硬要写出程序的话

n = Ceiling@Min[n /. Solve[n^2 + n + 41 == 1000, n]];
Times@@CoefficientList[Expand[(x + n)^2 + (x + n) + 41], x]

# P28: 螺旋数阵对角线

Number spiral diagonals

从 1 开始, 按顺时针顺序向右铺开的 5 × 5 螺旋数阵如下所示:

\begin{matrix} \color{red}{21} & 22 & 23 & 24 & \color{red}{25}\\ 20 & \color{red}{7} & 8 & \color{red}{9} & 10\\ 19 & 6 & \color{red}{1} & 2 & 11\\ 18 & \color{red}{5} & 4 & \color{red}{3} & 12\\ \color{red}{17} & 16 & 15 & 14 & \color{red}{13} \end{matrix}

可以验证, 该数阵对角线上的数之和是 101.

以同样方式构成的 1001 × 1001 螺旋数阵对角线上的数之和是多少?

唔, 观察法, 差是 2,2,2,2,4,4,4,4,6,6,6,6,8,8,8,8.....

好吧其实我不是一上来就想到观察法的, 我一上来在想怎么生成这个矩阵, 然后稍微推导了一下, 最后化简的时候才发现这个规律的.

我必须要祭出我研究了半天的螺旋矩阵, 虽然算法效率捉鸡至极.

SpiralMatrix[n_?OddQ] := Permute[Range[n^2], Accumulate@Take[Join[{n^2 + 1} / 2, Flatten@Table[(-1)^j i, {j, n}, {i, {-1, n}}, {j}]], n^2]] ~ Partition ~ n;
SpiralMatrix[n_] := SpiralMatrix[n + 1][[1 ;; -2, 2 ;; -1]]

正常解法:

Total[4 (2 #+1)^2-12 #&/@Range@500]+1

# P29: 不同的幂

Distinct powers

考虑所有满足 的整数组合生成的幂 ab:

\begin{array}{llll} 2^2=4 & 2^3=8 & 2^4=16 & 2^5=32 \\ 3^2=9 & 3^3=27 & 3^4=81 & 3^5=243 \\ 4^2=16 & 4^3=64 & 4^4=256 & 4^5=1024 \\ 5^2=25 & 5^3=125 & 5^4=625 & 5^5=3125 \end{array}

如果把这些幂按照大小排列并去重, 我们得到以下由 15 个不同的项组成的序列:

在所有满足 的整数组合生成的幂 ab 排列并去重所得到的序列中, 有多少个不同的项?

我们可是科学计算软件, 算什么大数, 上穷举, 不虚的.

Length@DeleteDuplicates[Power@@@Tuples[Range[2, 100], 2]]

# P30: 各位数字的五次幂

Digit fifth powers

令人惊讶的是, 只有三个数可以写成它们各位数字的四次幂之和:

由于 不是一个和, 所以这里并没有把它包括进去.

这些数的和是 .

找出所有可以写成它们各位数字的五次幂之和的数, 并求这些数的和.

位数的话最大值就是 , 而各位数字五次方之和最大就是

解个方程求出上界. 上界不算大, 穷举呗, fooQ 进行判定, Select 选一下就行了呗.

fooQ = Plus@@(Power[#, 5]& /@ IntegerDigits[#]) == #&;
max = First[n /. NSolve[{10^n - 1 == 9^5n, n > 1}, n]];
Total@Select[Range[1, Floor[10^max]], fooQ] - 1

连续计时 12 分 44 秒.

卡了 P27, P28, 其他秒杀.