EulerProject

# P71: 有序分数

Ordered fractions

考虑形如 n/d 的分数, 其中 n 和 d 均为正整数.

如果 且其最大公约数为 , 则该分数称为最简真分数.

如果我们将 的最简真分数构成的集合按大小升序列出, 我们得到:

1/8, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 3/8, 2/5, 3/7, 1/2, 4/7, 3/5, 5/8, 2/3, 5/7, 3/4, 4/5, 5/6, 6/7, 7/8

可以看出 2/5 是 3/7 直接左邻的分数.

将所有 的最简真分数按大小升序排列, 求此时 3/7 直接左邻的分数的分子.

找个函数来表示接近程度, 就是求

最大值的意思, 写完代码我看了眼输出, 我突然想到, 我在写什么玩意儿...

这玩意儿不是以 位周期单调递增吗, 那岂不是直接求 到 就完事了...

Numerator@Max@Cases[Table[Floor[3i / 7] / i, {i, 1*^6}], Except[3 / 7]]

# P72: 分数计数

Counting fractions

考虑形如 n/d 的分数, 其中 n 和 d 均为正整数. 如果 n < d 且其最大公约数为 1, 则该分数称为最简真分数.

如果我们将 的最简真分数构成的集合按大小升序列出, 我们得到:

1/8, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 3/8, 2/5, 3/7, 1/2, 4/7, 3/5, 5/8, 2/3, 5/7, 3/4, 4/5, 5/6, 6/7, 7/8

可以看出该集合中共有 21 个元素.

的最简真分数构成的集合中共有多少个元素?

最简真分数的个数其实就是欧拉函数值, 想下欧拉函数给出与 互质的正整数数目, 互质那不就最简真分数了吗

没听说过欧拉函数的和函数有快速计算方法的, 死算吧, 顶多来个并行.

Total@Array[EulerPhi,1*^6]-1 (* 直接算 *)
ParallelSum[EulerPhi[i],{i,1,1*^6}]-1 (* 并行化 *)

# P73: 分数有范围计数

Counting fractions in a range

考虑形如 n/d 的分数, 其中 n 和 d 均为正整数. 如果 n < d 且其最大公约数为 1, 则该分数称为最简真分数.

如果我们将 d ⩽ 8 的最简真分数构成的集合按大小升序列出, 我们得到:

1/8, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 3/8, 2/5, 3/7, 1/2, 4/7, 3/5, 5/8, 2/3, 5/7, 3/4, 4/5, 5/6, 6/7, 7/8

可以看出在 1/3 和 1/2 之间有 3 个分数.

将 的最简真分数构成的集合排序后, 在 1/3 和 1/2 之间有多少个分数?

我们用聪明点的穷举, 对于分母 , 先卡死上下界, 求里面和 互质的数个数就行.

ParallelSum[Boole[CoprimeQ[a, b]], {a, 1, 12000}, {b, Floor[a / 3 + 1], Ceiling[a / 2 - 1]}]

我们来封装成函数

rat[den_, f1_, f2_] := Length@Select[Range[Ceiling[den f1], Floor[den f2]], CoprimeQ[den, #]&];
ParallelSum[rat[n, 1 / 3, 1 / 2], {n, 12*^3}] - 2

# P74: 数字阶乘链

Digit factorial chains

之所以广为人知, 是因为它的各位数字的阶乘之和恰好等于本身:

而 则可能不太为人所知, 尽管从 开始不断地取各位数字的阶乘之和构成了最长的循环回到 ;

事实上, 只存在三个这样的循环:

不难证明, 从任意数字出发最终都会陷入循环. 例如,

从 开始可以得到一个拥有五个不重复项的链;

但是从一个小于一百万的数出发能够得到的最长的无重复项链包含有 项.

从小于一百万的数出发, 有多少条链恰好包含有 个不重复项?

有种不祥的预感, 是不是又要用编译了...

用点小技巧, 网上去查所有的不动点和循环链, 然后用模式对象和记忆化递归机制可以稍稍优化下.

其实之前 Collatz 那题也应该这么做, 不过当时我没想到.

F[1 | 2 | 145 | 40585] = 1;
F[871 | 872 | 45361 | 45362] = 2;
F[169 | 1454 | 363601] = 3;
F[n_] := F[n] = F@Total[IntegerDigits[n]!] + 1;
Count[Array[F, 1*^6], 60]

# P75: 唯一的整数边直角三角形

Singular integer right triangles

只能唯一地弯折成整数边直角三角形的电线最短长度是 12 厘米; 当然, 还有很多长度的电线都只能唯一地弯折成整数边直角三角形, 例如:

  • 12 厘米: (3,4,5)
  • 24 厘米: (6,8,10)
  • 30 厘米: (5,12,13)
  • 36 厘米: (9,12,15)
  • 40 厘米: (8,15,17)
  • 48 厘米: (12,16,20)

相反地, 有些长度的电线, 比如 20 厘米, 不可能弯折成任何整数边直角三角形, 而另一些长度则有多个解; 例如, 120 厘米的电线可以弯折成三个不同的整数边直角三角形.

  • 120 厘米: (30,40,50), (20,48,52), (24,45,51)

记电线长度为 L, 对于 , 有多少种取值只能唯一地弯折成整数边直角三角形?

这题我想错了, 我用的勾股树算法

a={{1,-2,2},{2,-1,2},{2,-2,3}};
b={{1,2,2},{2,1,2},{2,2,3}};
c={{-1,2,2},{-2,1,2},{-2,2,3}};
RTtree[p_]:=With[{lim=Total[p]},If[lim>max,SparseArray[{},max,0],
SparseArray[Table[i->1,{i,lim,max,lim}],max,0]+RTtree[a.p]+RTtree[b.p]+RTtree[c.p]]];
Block[{$RecursionLimit=2000},max=15*^5;Tally[RTtree[{3,4,5}]]]

后来想到干嘛不用广义勾股数组, 所有的勾股数组都能写成这个形式:

嗯, 我们来看一看一个流程完整的函数是什么样子的:

RTCount::usage="RTCount[max] 对小于 max 的整数可构成的直角三角形计数 \ r
RTCount[max,Return->True] 返回具体的每个整数的计数 \ r
RTCount[min,max] 返回区间 [min,max] 中的计数.";
RTCount::eq="你输入的最大值比最小值大, 请进行正确的输入.";
Unprotect[RTCount];Options[RTCount]={Return->False};
RTCount[max_?IntegerQ,OptionsPattern[]]:=Block[
  {CountArray=ConstantArray[0,max]},
  Do[If[CoprimeQ[a^2-b^2,2 a b,a^2+b^2],CountArray[[2a k(a+b)]]++],
    {a,1,Sqrt[max/2]},
    {b,If[OddQ@a,2,1],Min[(max-2 a^2)/(2 a),a-1],2},
    {k,1,max/(2 a (a+b))}];
  Return[If[OptionValue[Return],CountArray,Tally@CountArray]]];
RTCount[min_?IntegerQ,max_?IntegerQ,OptionsPattern[]]:=Block[
  {a=RTCount[max,Return->True],
  i=PadRight[RTCount[min-1,Return->True],max]},
  If[min>=max,Return[Message[RTCount::eq]]];
  Return[If[OptionValue[Return],a-i,Tally@Take[a-i,max-min]]]];
Protect[RTCount];

一个标准的函数同时要包括说明, 属性设定和错误捕捉, 可以的话要有必要的注释.

换行这种东西就无所谓了, 看个人风格, 我喜欢写成砖头的样子, 一行一赋值, 有模块或者循环就缩进. If 尽量写一行. 该代码已整合进 BGG. 本来还想加上并行化的, 但是并行循环这玩意儿实在是难写, 写了会儿不想动了...

然后可以直接调用 RTCount[15*^5].

# P76: 加和计数

Counting summations

将 5 写成整数的和有 6 种不同的方式:

  • 4 + 1
  • 3 + 2
  • 3 + 1 + 1
  • 2 + 2 + 1
  • 2 + 1 + 1 + 1
  • 1 + 1 + 1 + 1 + 1

将 100 写成整数的和有多少种不同的方式?

F1, 内置水过...

PartitionsP[100]

# P77: 素数加和

Prime summations

将 10 写成素数的和有 5 种不同的方式:

7 + 3 5 + 5 5 + 3 + 2 3 + 3 + 2 + 2 2 + 2 + 2 + 2 + 2

写成素数的和有超过五千种不同的方式的数最小是多少?

你以为换成素数我就秒杀不了了吗, 直接数?

NestWhile[#+1&,1,Length@IntegerPartitions[#,#,Prime@Range@#]<5000&]

# P78: 硬币分拆

Coin partitions

记 p(n) 是将 n 枚硬币分拆成堆的不同方式数. 例如, 五枚硬币有 7 种分拆成堆的不同方式, 因此 p(5)=7.

OOOOO OOOO O OOO OO OOO O O OO OO O OO O O O O O O O O

找出使 p(n) 能被一百万整除的最小 n 值.

秒杀吧.......Well, 失败了, 要跑好久, 让他跑着吧, 我做下一题了....

NestWhile[#+1&,1,!Divisible[PartitionsP@#,1*^6]&]

# P79: 密码推断

Passcode derivation

网上银行常用的一种密保手段是向用户询问密码中的随机三位字符. 例如, 如果密码是 531278, 询问第 2, 3, 5 位字符, 正确的回复应当是 317.

在文本文件 keylog.txt 中包含了 50 次成功登陆的正确回复.

假设三个字符总是按顺序询问的, 分析这个文本文件, 给出这个未知长度的密码最短的一种可能.

不想解释, 这个问题推广一下就能黑密保卡了....

如果我能一直监听一个用户输密保密码, 足够多的次数后就能得知这张密保卡上写了啥啦!

data=Import["https://projecteuler.net/project/resources/p079_keylog.txt","List"];
rule=Union[IntegerDigits@data/.{a_,b_,c_}:>Sequence[{a,b},{b,c},{a,c}]];
FromDigits[Range[0,9]//.(rule/.{b_,a_}->{X___,a,Y___,b,Z___}->{X,b,Y,a,Z})]

# P80: 平方根数字展开

Square root digital expansion

For the first one hundred natural numbers, find the total of the digital sums of the first one hundred decimal digits for all the irrational square roots.

对于前一百个自然数, 求所有无理数平方根小数点后一百位数字的总和.

最近几道压轴题里最水的, RealDigits 秒了.....

Total@Flatten@Table[RealDigits[Sqrt@i, 10, 100, -1], {i, 100}]

大叉, 纳尼??? 然后我看了半天发现要求的是无理数, Well, 还要额外处理一下.......

还有是求前 100 位不是小数点后 100 位, 不过我记得 Decimal digits 不是小数位的意思吗...

Total@Flatten[First@RealDigits[#,10,100]&/@Cases[Sqrt@Range@100,Except[_Integer]]]
Total@Flatten@IntegerDigits@Floor[1*^99Array[Sqrt,100]]-46

连续计时 26 分 59 秒, P75 看上去简单但是还是有点难, P80 题没看懂瞎搞, 一次冻 30 秒, 无妄之灾...

← Level81-90 →