# P51: 素数数字替换

Prime digit replacements

将两位数乘 的第一个数字代换为任意数字, 在九个可能值中有六个是素数: .

将五位数 56**3 的第三和第四位数字代换为相同的任意数字, 就得到了十个可能值中有七个是素数的最小例子, 这个素数族是: .

作为这一族中最小的成员, 也是最小的满足这个性质的素数.

通过将部分数字 (不一定相邻) 代换为相同的任意数字, 有时能够得到八个素数, 求满足这一性质的最小素数.

竟然..... 没做出来, 放弃...... 实在不会剪枝....

Get["https://raw.githubusercontent.com/GalAster/BiGridGenerator/master/BiGridGenerator/Kernel/ExCode/ExNumber.m",CharacterEncoding->"UTF-8"]
? DigitReplacePrime
Do[If[DigitReplacePrime[i,j,8]!={},Return[DigitReplacePrime[i,j,8]]],{i,1,Infinity},{j,i,3,-1}][[1,1]]

# P52: 重排的倍数

Permuted multiples

可以看出, 和它的两倍 拥有同样的数字, 只是排列顺序不同.

有些正整数 满足 都拥有相同的数字, 求其中最小的正整数.

我看了看题, 第一反应 142857, 然后跑出来真的是 142857...... 这就很尴尬了...

NestWhile[# + 1&, 1, Not[SameQ@@Table[Sort[IntegerDigits[i #]], {i, 6}]]&]

# P53: 组合数选择

Combinatoric selections

从五个数 12345 中选择三个恰好有十种方式, 分别是:

在组合数学中, 我们记作:

一般来说,

直到 时, 才出现了超出一百万的组合数:

若数值相等形式不同也视为不同, 对于 , 有多少个组合数 超过一百万?

穷举水过

Length@Select[Flatten[Table[Binomial[n, r], {n, 1, 100}, {r, 1, n}], 1], # > 1*^6&]

# P54: 扑克手牌

Poker hands

在扑克游戏中, 玩家的手牌由五张牌组成, 其等级由低到高分别为:

  • 单牌: 牌面最大的一张牌.
  • 对子: 两张牌面一样的牌.
  • 两对: 两个不同的对子.
  • 三条: 三张牌面一样的牌.
  • 顺子: 五张牌的牌面是连续的.
  • 同花: 五张牌是同一花色.
  • 葫芦: 三条带一个对子.
  • 四条: 四张牌面一样的牌.
  • 同花顺: 五张牌的牌面是连续的且为同一花色.
  • 同花大顺: 同一花色的 10, J, Q, K, A.

牌面由小到大的顺序是: 2, 3, 4, 5, 6, 7, 8, 9, 10, J, Q, K, A.

如果两名玩家的手牌处于同一等级, 那么牌面较大的一方获胜; 例如, 一对 8 胜过一对 5(参见例 1); 如果牌面相同, 例如双方各有一对 Q, 那么就比较玩家剩余的牌中最大的牌 (参见例 4); 如果最大的牌相同, 则比较次大的牌, 依此类推.

考虑以下五局游戏中双方的手牌:

手牌 玩家 1 玩家 2 胜者 1 红桃 5 草花 5 黑桃 6 黑桃 7 方片 K 草花 2 黑桃 3 黑桃 8 方片 8 方片 10 玩家 2

一对 5 一对 8 2 方片 5 草花 8 黑桃 9 黑桃 J 草花 A 草花 2 草花 5 方片 7 黑桃 8 红桃 Q 玩家 1

单牌 A 单牌 Q 3 方片 2 草花 9 黑桃 A 红桃 A 草花 A 方片 3 方片 6 方片 7 方片 10 方片 Q 玩家 2

三条 A 同花方片 4 方片 4 黑桃 6 红桃 9 红桃 Q 草花 Q 方片 3 方片 6 红桃 7 方片 Q 黑桃 Q 玩家 1

一对 Q 一对 Q

最大单牌 9 最大单牌 7 5 红桃 2 方片 2 草花 4 方片 4 黑桃 4 草花 3 方片 3 黑桃 3 黑桃 9 方片 9 玩家 1

葫芦 葫芦

(三条 4) (三条 3) 在这个文本文件 poker.txt 中, 包含有两名玩家一千局的手牌. 每一行包含有 10 张牌 (均用一个空格隔开): 前 5 张牌属于玩家 1, 后 5 张牌属于玩家 2. 你可以假定所有的手牌都是有效的 (没有无效的字符或是重复的牌), 每个玩家的手牌不一定按顺序排列, 且每一局都有确定的赢家.

其中有多少局玩家 1 获胜?

跳过未做, 未计时.

ShowHardQ 函数返回给定牌局的胜负向量, 输入长度除以 5 返回对应的排序向量.

因为梭哈赢者通吃, 4 人的话返回就是 {0,0,0,1} 这种胜负向量. 不要传长度不是 5 倍数的异常数据, 我可没有写异常捕捉.

$CharacterEncoding="UTF-8";
Get["https://raw.githubusercontent.com/GalAster/BiGridGenerator/master/BiGridGenerator/Kernel/Game/CardGames.m"];
data=Import["https://projecteuler.net/project/resources/p054_poker.txt","Table"];
Total[Transpose[ShowHardQ/@data][[1]]]

# P55: 利克瑞尔数

Lychrel numbers

倒序并相加得到 , 是一个回文数.

不是所有的数都能像这样迅速地变成回文数. 例如,

也就是说, 需要迭代三次才能变成回文数.

尽管尚未被证实, 但有些数, 例如 , 被认为永远不可能变成回文数.

如果一个数永远不可能通过倒序并相加变成回文数, 就被称为利克瑞尔数.

出于理论的限制和问题的要求, 在未被证否之前, 我们姑且就认为这些数确实是利克瑞尔数.

除此之外, 已知对于任意一个小于一万的数, 它要么在迭代 次以内变成回文数, 要么就是没有人能够利用现今所有的计算能力将其迭代变成回文数.

事实上, 是第一个需要超过 次迭代变成回文数的数, 这个回文数是 ( 次迭代, 位数).

令人惊讶的是, 有些回文数本身也是利克瑞尔数数; 第一个例子是 .

小于一万的数中有多少利克瑞尔数?

它的意思就是迭代 次, 还没完就是利克瑞尔数.

那就直接全跑一便呗...

fooQ = Reverse@# + #&@IntegerDigits@FromDigits@#&;
Tr@Boole@Array[Max@# > 9&@NestWhile[fooQ, fooQ@{#}, Max@# > 9&, 1, 50]&, 1*^4]

# P56: 幂的数字和

Powerful digit sum

一古戈尔(Googol) 是一个巨大的数字: 一后面跟着一百个零.

则更是无法想像地巨大: 一后面跟着两百个零.

然而, 尽管这两个数如此巨大, 各位数字和却都只有 .

, 所有能表示为 的自然数中, 最大的各位数字和是多少?

穷举水过, 然后我又没看到小于号.....

Max@Flatten@Table[Total@IntegerDigits[a^b], {a, 99}, {b, 99}]

# P57: 平方根逼近

Square root convergents

的平方根可以用一个无限连分数表示:

将连分数计算取前四次迭代展开式分别是:

接下来的三个迭代展开式分别是 , 但是直到第八个迭代展开式 , 分子的位数第一次超过分母的位数.

在前一千个迭代展开式中, 有多少个分数分子的位数多于分母的位数?

生成分子分母的列表然后比比就行了呗.

\begin{aligned} a_n &= \frac{b}{a}\\ a_{n + 1} &= \frac{2a + b}{a + b} = 1 + \frac{1}{1 + a_n} \end{aligned}

data = NestList[{2#[[2]] + #[[1]], #[[2]] + #[[1]]}&, {1, 1}, 1000];
Total@Boole[Greater@@@IntegerLength@data]

# P58: 螺旋素数

Spiral primes

从 1 开始逆时针螺旋着摆放自然数, 我们可以构造出一个边长为 7 的螺旋数阵.

37 36 35 34 33 32 31
38 17 16 15 14 13 30
39 18  5  4  3 12 29
40 19  6  1  2 11 28
41 20  7  8  9 10 27
42 21 22 23 24 25 26
43 44 45 46 47 48 49

可以发现, 所有的奇数平方都在这个螺旋方针的右下对角线上, 更有趣的是, 在所有对角线上一共有 个素数, 比例达到 .

在这个方阵外面完整地再加上一层, 就能构造出一个边长为 的螺旋方阵. 如果不断重复这个过程, 当对角线上素数的比例第一次低于 时, 螺旋数阵的边长是多少?

好像... 更加用不到我辛辛苦苦造的螺旋矩阵了...

规律上次 28 题已经找过了. 先生成这个序列 data 再说.

然后左边开始卷这个列表, 卷到素数低于 10% 为止.

这个思路可以泛化, 稍微改下通项公式就可以求一个难以分析的数列的奇偶比例变化之类的...

data = Sort@Flatten@Table[4 n^2 + (2 j - 4) n + 1, {j, 0, 3}, {n, 2, 20000}];
ListCount[{a_, b_}, n_] := If[PrimeQ@n, {a + 1, b + 1}, {a + 1, b}]
ans = Select[FoldList[ListCount, {4, 3}, data], #[[2]] / #[[1]] < 0.1&]
(ans[[1, 1]] + 1) / 2

# P59: 异或解密

XOR decryption

计算机上的每个字符都被指定了一个独特的代码, 其中被广泛使用的一种是 ASCII 码 (美国信息交换标准代码). 例如, 大写字母 A = 65, 星号 (*) = 42, 小写字母 k = 107.

一种现代加密方法是将一个文本文档中的符号先转化为 ASCII 码, 然后将每个字节异或一个根据密钥确定的值. 使用异或进行加密的好处在于, 只需对密文使用相同的密钥再加密一次就能得到明文, 例如, 65 XOR 42 = 107, 而 107 XOR 42 = 65.

为了使加密难以破解, 密钥要和明文一样长, 由随机的字节构成. 用户会把加密过的信息和密钥放置在不同的地方, 解密时二者缺一不可.

不幸的是, 这种方法对大多数人来说并不实用, 因此一个略有改进的方法是使用一个密码作为密钥. 密码的长度很有可能比信息要短, 这时候就循环重复使用这个密码进行加密. 这种方法需要达到一种平衡, 一方面密码要足够长才能保证安全, 另一方面需要充分短以方便记忆.

你的破解任务要简单得多, 因为密钥只由三个小写字母构成. 文本文档 cipher.txt(右击并选择 "目标另存为……") 中包含了加密后的 ASCII 码, 并且已知明文包含的一定是常见的英文单词, 解密这条消息并求出原文的 ASCII 码之和.

跳过未做, 未计时.

轮一遍, 找里面有 the 的... 我就不信一段常见英文能没有 the...

包容判定 the 长短正好, 太长比如 this,that 都无解, in,of,to 之类的介词就太短了人肉要死...was 也没成...

怎么说呢, 这么搞比较凑巧, 比较正统的方法还是频度分析, 一般把字母 e 作为切入口, 因为出现次数几乎最多.

比如维基上 Math 的页面统计:

Take[Reverse[Sort[CharacterCounts[WikipediaData["Math"]]]], 10]
<|""->4832,"e"->3078,"t"->2586,"a"->2455,"i"->2241,"n"->1925,"s"->1884,"o"->1826,"r"->1443,"h"->1212|>

除了空格就是 e 出现次数最多, 密文的统计结果如下:

<|""->219,"e"->120,"h"->84,"t"->80,"o"->70,"n"->67,"i"->67,"a"->54,"s"->51,"r"->38|>
list = ToExpression /@ StringSplit[Import["https://projecteuler.net/project/resources/p059_cipher.txt"], ","];
CyclicList[x_, y_] := Drop[Join@@ConstantArray[x, Ceiling[y / Length[x]]], Mod[y, Length[x], 1] - Length[x]];
GetText[x_, y_] := StringJoin@@FromCharacterCode[BitXor[Take[list, y], CyclicList[x, y]]];
Select[{#, GetText[#, 20]}& /@ Tuples[Range[97, 122], 3], StringContainsQ[ToLowerCase[#[[2]]], "the"]&]
Total[ToCharacterCode[GetText[{103, 111, 100}, Length[list]]]]

如果有人对密文感兴趣的话, 我就贴出来好了. 密匙:"god", 密文约翰福音第一章.

# The Gospel of John, chapter 1

  1. In the beginning the Word already existed. He was with God, and he was God.
  2. He was in the beginning with God.
  3. He created everything there is. Nothing exists that he didn't make.
  4. Life itself was in him, and this life gives light to everyone.
  5. The light shines through the darkness, and the darkness can never extinguish it.
  6. God sent John the Baptist
  7. to tell everyone about the light so that everyone might believe because of his testimony.
  8. John himself was not the light; he was only a witness to the light.
  9. The one who is the true light, who gives light to everyone, was going to come into the world.
  10. But although the world was made through him, the world didn't recognize him when he came.
  11. Even in his own land and among his own people, he was not accepted.
  12. But to all who believed him and accepted him, he gave the right to become children of God.
  13. They are reborn! This is not a physical birth resulting from human passion or plan, this rebirth comes from God.
  14. So the Word became human and lived here on earth among us. He was full of unfailing love and faithfulness. And we have seen his glory, the glory of the only Son of the Father.

# 约翰福音 第一章

  1. 太初有道, 道与神同在, 道就是神.
  2. 这道太初与神同在.
  3. 万物是借着他造的.凡被造的, 没有一样不是借着他造的.
  4. 生命在他里头.这生命就是人的光.
  5. 光照在黑暗里, 黑暗却不接受光.
  6. 有一个人, 是从神那里差来的, 名叫约翰.
  7. 这人来, 为要作见证, 就是为光作见证, 叫众人因他可以信.
  8. 他不是那光, 乃是要为光作见证.
  9. 那光是真光, 照亮一切生在世上的人.
  10. 他在世界, 世界也是借着他造的, 世界却不认识他.
  11. 他到自己的地方来, 自己的人倒不接待他.
  12. 凡接待他的, 就是信他名的人, 他就赐他们权柄, 作神的儿女.
  13. 这等人不是从血气生的, 不是从情欲生的, 也不是从人意生的, 乃是从神生的.
  14. 道成了肉身, 住在我们中间, 充充满满的有恩典有真理. 我们也见过他的荣光, 正是父独生子的荣光.

# P60: 素数对的集合

Prime pair sets

是非常特别的一组素数.

任取其中的两个并且以任意顺序连接起来, 其结果仍然是个素数.

例如, 选择 , 我们得到 均为素数.

这四个素数的和是 , 这是满足这个性质的一组四个素数的最小和.

若有一组五个素数, 任取其中的两个并且以任意顺序连接起来, 其结果仍然是个素数, 求这样一组素数的最小和.

似乎是上次那道的简单版, 就取三位被多少多少除的那道.

直接穷举肯定不行, C[n,5] 的复杂度, 简直是在开玩笑...

我们可以先写个朴素的判定:

foo[{a_, b_}] := FromDigits[IntegerDigits@a ~ Join ~ IntegerDigits@b];
fooQ = PrimeQ[foo@#] && PrimeQ[foo@Reverse@#]&;

一个素数二元组正反连起来还是个素数. 然后我们可以试一个范围比如 1 万以下的质数.

炫酷的事情来了, 我们把这些个二元组组成一个无向图, 于是有关系的点就会成团, 我们只要找正好含有 5 个点的团就行了!

foo[{a_, b_}] := FromDigits[IntegerDigits@a ~ Join ~ IntegerDigits@b];
fooQ = PrimeQ[foo@#] && PrimeQ[foo@Reverse@#]&;
data = Select[Prime@Range@PrimePi@1*^4 ~ Subsets ~ {2}, fooQ];
Plus@@@FindClique[Graph[UndirectedEdge@@@data], {5}]

连续计时 24 分 15 秒...

啊咧, 越来越慢了, 就算我两题没做时间还是变长了, 主要是分析过程越来越长了, 没法看一眼出思路...