# 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 的姓名得分是
文件中所有姓名的姓名得分之和是多少?
真心不知道这个是什么鬼格式, 只能手动转化成列表了. 复习下 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
考虑所有满足
\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 个不同的项组成的序列:
在所有满足
我们可是科学计算软件,
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, 其他秒杀.
← Level11-20 Level31-40 →