EulerProject

# P101: 最优多项式

Optimum polynomial

如果我们知道了一个数列的前 项, 我们仍无法确定地给出下一项的值, 因为有无穷个多项式生成函数都有可能是这个数列的模型.

例如, 让我们考虑立方数的序列, 它可以用如下函数生成:

如果我们只知道数列的前两项, 秉承 "简单至上" 的原则, 我们应当假定这个数列遵循线性关系, 并且预测下一项为 (公差为 ). 即使我们知道了数列的前三项

根据同样的原则, 我们也应当首先假定数列遵循二次函数关系.

给定数列的前 项, 定义 是由最优多项式生成函数给出的第 项的值.

显然 可以精确地给出 的那些项, 而可能的 ** 第一个不正确项 (First Incorrect Term, 简记为 FIT)** 将会是 .

如果事实的确如此, 我们称这个多项式为 坏最优多项式 (Bad OP, 简记为 BOP).

在最基本的情况下, 如果我们只得到了数列的第一项, 我们应当假定数列为常数, 也就是说, 对于 .

由此, 我们得到了立方数列的最优多项式如下:

Formula Terms

显然, 当 时不存在坏最优多项式.

所有坏最优多项式的第一个不正确项 (用 ** 红色 ** 标示的数) 之和为 .

考虑下面这个十阶多项式生成函数:

求其所有坏最优多项式的第一个不正确项之和.

送分题, 直接插值然后验证后一项即可

u[n_] := 1 - n + n^2 - n^3 + n^4 - n^5 + n^6 - n^7 + n^8 - n^9 + n^10
op[n_] := InterpolatingPolynomial[Array[u, n], x]
Array[op@# /. x -> # + 1&, 10] // Total

式子可以写成 , 而且指数反人类的从小到大排列, 这是从 Mathematica 里复制出来的吧...

没事干还可以压个行:

Sum[InterpolatingPolynomial[Array[Sum[(-1)^i#^i, {i, 0, 10}]&, n], n + 1], {n, 10}]

# P102: 包含原点的三角形

Triangle containment

从笛卡尔平面中随机选择三个不同的点, 其坐标均满足 , 这三个点构成一个三角形.

考虑下面两个三角形:

\begin{matrix} &A(-340,495)&B(-153,-910)&C(835,-947)\\ &X(-175,41)&Y(-421,-714)&Z(574,-645)\\ \end{matrix}

可以验证 包含原点, 而 不包含原点.

在 27K 的文本文件 triangles.txt 中包含了一千个 "随机" 三角形的坐标, 找出其中包含原点在其内部的三角形的数量.

注意: 文件中的前两个三角形就是上述样例.

大概是高中解析几何难度: Triangle Interior

get = Import["https://projecteuler.net/project/resources/p102_triangles.txt", "CSV"];
InTriangleQ[x_, y_, {x0_, y0_, x1_, y1_, x2_, y2_}] := Block[
    {
        a = Sign[(x0 - x1) * (y - y0) - (y0 - y1) * (x - x0)],
        b = Sign[(x1 - x2) * (y - y1) - (y1 - y2) * (x - x1)],
        c = Sign[(x2 - x0) * (y - y2) - (y2 - y0) * (x - x2)]
    },
    a == 0 || b == 0 || c == 0 || (a == b && b == c)
];
Select[get, Function[tri, InTriangleQ[0, 0, tri]]] // Length

不过其实有内置函数, 一行流走一波:

get = Import["https://projecteuler.net/project/resources/p102_triangles.txt", "CSV"];
Count[RegionMember[Triangle@Partition[#, 2], {0, 0}]& /@ get, True]
Count[SignedRegionDistance[Triangle[#], {0., 0}]& /@ Map[Partition[#, 2]&, get], _?Negative]

第一种直接判定居然比第二种计算距离还慢也是无敌, 比我手写外加没编译的函数还慢真的无敌.

# P103: 特殊的子集和: 最优解

Special subset sums: optimum

记 是大小为 的集合 中所有元素的和.

若任取 的任意两个非空且不相交的子集 和 都满足下列条件, 我们称 是一个特殊的和集:

  1. ; 也就是说, 任意子集的和不相同.
  2. 如果 中的元素比 多, 则 .

对于给定的 , 我们称使得 最小的集合 为最优特殊和集.

前 5 个最优特殊和集如下所示.

似乎对于一个给定的最优特殊和集 , 下一个最优特殊和集将是 的形式, 其中 是集合 "正中间" 的元素.

应用这条 "规则", 我们猜测对于 的最优特殊和集将是 , 相应的 .

然而, 事实并非如此, 我们的方法仅仅只能找出近似最优特殊和集.

对于 , 最优特殊和集是 , 相应的 , 对应的集合数字串是:.

若集合 是 时的最优特殊和集, 求其对应的集合数字串.

我是在做江苏高考的数列压轴题吗, 这都什么鬼啊...

还带一个错误的猜测的说, 和阅读理解似的.

这规则到底有啥用啊, 题看起来就想要暴搜一样, 但是给了你个范围吗......

看起来像是 搜一下就行了?

更加神经病的是, 的情况不是反例...

t = 20 + {0, 11, 18, 19, 20, 22, 25}
g = # + t& /@ Tuples[Range[-1, 1], {7}];
sQ[l_] := Length@DeleteDuplicates@# == Length@#&@(Total /@ Subsets[l]);
StringRiffle[SortBy[Select[g, sQ], Total] // First, ""]

喂, 什么破题, 我想了半个小时不知这题在干嘛

后来查了下这个还和一个叫 k-SSD 的问题有点关系, 链接: SUBSET-SUM-DISTINCT SEQUENCE

# P104: 两端为全数字的斐波那契数

Pandigital Fibonacci ends

斐波那契数列由如下递归关系生成:

可以发现, 包含有 位数字的 是第一个后 位数字是 至 全数字 (包含 至 所有的数字, 但不一定按照从小到大的顺序) 的斐波那契数;

而包含有 位数字的 是第一个前 位数字是 至 全数字的斐波那契数.

若 是第一个前 9 位数字和后 9 位数字都是 1 至 9 全数字的斐波那契数, 求 k.

虽然 Mathematica 有内置的函数, 不过你真去算就中计了

虽然暴力也不是不能一分钟内搞定, 但是人家只要前九位后九位, 你干嘛做那么多无用功呢

前九位直接数值近似就行, 后九位用带模加法, 这样时空复杂度就都低了不是.

NextFib[{n_, f1_, f2_}] := Mod[{n + 1, f2, f1 + f2}, 1*^9];
First9[n_] := First@RealDigits[GoldenRatio^n / Sqrt[5], 10, 9];
PanQ = Sort[#] == Range[9]&;
Test[{n_, f1_, f2_}] := !(PanQ@IntegerDigits[f2] && PanQ@First9[n]);
NestWhile[NextFib, {2, 1, 1}, Test] // First

# P105: 特殊的子集和: 检验

Special subset sums: testing

记 是大小为 的集合 中所有元素的和.

若任取 的任意两个非空且不相交的子集 和 都满足下列条件, 我们称 是一个特殊的和集:

  1. ; 也就是说, 任意子集的和不相同.
  2. 如果 中的元素比 多, 则 .

例如 不是一个特殊和集, 因为 ;

而 满足上述规则, 且相应的 .

在 4K 的文本文件 sets.txt 中包含了一百组包含 7 至 12 个元素的集合 (文档中的前两个例子就是上述样例), 找出其中所有的特殊和集 , 并求 的值.

我去, 怎么又是你个破题, 我真........

就照着他先判定然后求和就行, 可以用向量化的写法加速

raw = Import["https://projecteuler.net/project/resources/p105_sets.txt", "CSV"];
test = Join@@Table[Sort[Total /@ Subsets[#, {i}]], {i, Length@#}]& /@ raw;
Total[Pick[raw, Union@# === #& /@ test], 2]

# P106: 特殊的子集和: 元检验

Special subset sums: meta-testing

记 是大小为 的集合 中所有元素的和.

若任取 的任意两个非空且不相交的子集 和 都满足下列条件, 我们称 是一个特殊的和集:

  1. ; 也就是说, 任意子集的和不相同.
  2. 如果 中的元素比 多, 则 .

在这个问题中我们假定集合中包含有 个严格单调递增的元素, 并且已知其满足第二个条件.

令人惊奇的是, 当 时, 在所有可能的 组子集对中只有 组需要检验子集和是否相等 (第一个条件).

同样地, 当 时, 在所有可能的 组子集对中只有 组需要检验.

当 时, 在所有可能的 组子集对中有多少组需要检验?

我了个去啊老铁, 我不想看见你了, 这次又玩什么花样啊...

我很忙的啊, 我真心不想做阅读理解了......

好吧, 为什么 只有一组需要检验呢....

时, B, C 集合可以取 1-1, 1-2, 1-3, 2-2 四种情况, 加起来一共有 25 种不同的情况.

其中, 因为集合是递增的且满足条件 2, 所以 1-1, 1-2, 1-3 肯定能满足条件 1.

这时只需考虑 2-2 的情况:

不妨设 4 个元素 , 则 2-2 只有以下 种情况:

ab-cd ac-bd ad-bc

其中只有 ad-bc 是需要检验的, 因为这两个集合里元素是 "有大有小" 的.

所以一般 怎么办呢?

首先分成两个集合的方式有多种, 但是有可能需要检验的情况只有 r-r 两个集合元素数目相同的情况, 此时集合的个数为

然后其中需要检验的只有那种 "有大有小" 的, 它的反面是每次取两个元素一个给 b 一个给 c, 给的 b 的总是小于给 c 的, 这种的个数为

只需要枚举不同的 r 即可, 公式为

这题真该拿出来当江苏高考压轴题...

# P107: 最小网络

Minimal network

下面这个无向网络包含有 个顶点和 条边, 其总权重为 .

这个网络也可以用矩阵的形式表示如下.

\begin{matrix} & A & B & C & D & E & F & G \\ A & - & 16 & 12 & 21 & - & - & - \\ B & 16 & - & - & 17 & 20 & - & - \\ C & 12 & - & - & 28 & - & 31 & - \\ D & 21 & 17 & 28 & - & 18 & 19 & 23 \\ E & - & 20 & - & 18 & - & - & 11 \\ F & - & - & 31 & 19 & - & - & 27 \\ G & - & - & - & 23 & 11 & 27 & - \end{matrix}

然而, 我们其实可以优化这个网络, 移除其中的一些边, 同时仍然保证每个顶点之间都是连通的. 节省重量最多的网络如下图所示, 其总重量为 93, 相比原来的网络节省了 .

在这个 6K 的文本文件 network.txt 中存放了一个包含有 40 个顶点的网络的连通矩阵. 移除其中冗余的边, 同时仍然保证每个顶点之间都是连通的, 求最多能节省的重量.

就是带权的最小生成树呗, FindSpanningTree 秒杀.

file = "https://projecteuler.net/project/resources/p107_network.txt";
d = Import[file, "Data"] /. "-" -> Infinity;
s = FindSpanningTree[g = WeightedAdjacencyGraph[d]];
HighlightGraph[g, s, GraphLayout -> "CircularEmbedding", GraphHighlightStyle -> "Thick"]
Total[WeightedAdjacencyMatrix[EdgeDelete[g, EdgeList@s]], 2] / 2

哎呀, 我甚至还有空画个图, 233.

# P108: 丢番图倒数 I

Diophantine reciprocals I

在如下方程中, 均为正整数.

对于 n = 4, 上述方程恰好有 3 个不同的解:

\begin{aligned} \frac{1}{5}+\frac{1}{20}&=\frac{1}{4}\\ \frac{1}{6}+\frac{1}{12}&=\frac{1}{4}\\ \frac{1}{8}+\frac{1}{8}&=\frac{1}{4}\\ \end{aligned}

使得不同的解的数目超过 的最小 值是多少?

我倒是还想直接内置函数秒杀, 一波直接跪了.

NestWhile[#+1&,1,Length@Solve[{1/x+1/y==1/#,x>=y>0},{x,y},Integers]<10&]

翻车翻车, 这题解题思路不太好想到.

设 , 考虑方程

化简得到 , 也就是解得个数其实就是 的因数个数, 但是注意 , 所以记得只算一半.

NestWhile[#+1&,1,(DivisorSigma[0,#^2]+1)/2<=1000&]

# P109: 飞镖

Darts

在飞镖游戏中, 玩家需向靶子上投掷三枚飞镖; 靶子被分成了二十个相等面积的区域, 并分别标上 1 至 20.

每一枚飞镖的分数还取决于它的位置. 落在外围的红 / 绿色圈以外时为零分, 落在黑 / 白色区域时为一倍得分, 而落在外围和中间的红 / 绿色圈时分别为两倍和三倍得分.

在把子的正中心有两个同心圆, 被称为靶心. 射中靶心外圈得 25 分, 射中靶心内圈则得双倍 50 分.

飞镖的规则有许多变种, 但最热门的一种是, 每个玩家从 301 分或 501 分开始, 轮流投掷飞镖并减去得分, 首先将自己的分数减少到恰好为 0 的玩家获胜. 不过, 通常会采用 "双倍结束" 规则, 即玩家在最后一镖必须射中一个双倍区域 (包括双倍的靶心内圈) 才能判定获胜. 若这一轮的得分使得玩家的分数减少到 1 分或更少, 但最后一镖未射中双倍区域, 则这一轮的得分 "作废".

玩家在目前的分数下能够获胜则被称为 "结分". 最高的结分为 170:T20+T20+D25(两个三倍 20 分和一个双倍靶心).

当玩家分数为 6 时, 恰好有 11 种结分方式:

  • D3
  • D1 + D2
  • S2 + D2
  • D2 + D1
  • S4 + D1
  • S1 + S1 + D2
  • S1 + T1 + D1
  • S1 + S3 + D1
  • D1 + D1 + D1
  • D1 + S2 + D1
  • S2 + S2 + D1

注意 D1 + D2 被认为是 不同于 D2 + D1 的结分方式, 因为它们最后的双倍不同.

不过, 组合 S1 + T1 + D1 和 T1 + S1 + D1 就被认为是 相同的 结分方式.

另外, 我们在计算组合时, 我们不考虑脱靶的情况;

例如, D3 和 0 + D3 以及 0 + 0 + D3 就是 相同的 结分方式.

令人惊奇的是一共有 种不同的结分方式.

当玩家分数小于 时, 一共有多少种不同的结分方式?

阅读理解题, again, 总会有那么几道, 让人看了题干就头大的.

只要有耐心阅读理解都是不难的题, 只要有耐心.

s = Flatten[Append[Table[{{i}, {i, i}, {i, i, i}}, {i, 1, 20}], {{25}, {25, 25}}], 1];
Win1 = Select[s, Length[#] == 2&];
Win2 = Tuples[{Win1, s}];
Win3 = Tuples[{Win1, Union[Sort /@ Tuples[{s, s}]]}];
Length[Select[Union[Win1, Win2, Win3], Plus@@Flatten[#] < 100&]]

哦对了, 我生成函数今天就是要教你做人:

f[n_] := x^n(x^(20n) - 1) / (x^n - 1);
g = f[1] + f[2] + f[3] + x^25 + x^50;
h = f[2] + f[4] + f[6] + x^50 + x^100;
PolynomialMod[((g^2 + h) / 2 + g + 1) * (f[2] + x^50), x^100] ~ PolynomialMod ~ (x - 1)

拿错了, 应该是下面这个:

fx = x^2 + x^3 + 4 x^4 + 5 x^5 + 11 x^6 + 12 x^7 + 22 x^8 + 22 x^9 + 36 x^10 + 36 x^11 + 53 x^12 \
    + 52 x^13 + 76 x^14 + 71 x^15 + 100 x^16 + 95 x^17 + 128 x^18 + 120 x^19 + 162 x^20 + 148 x^21 \
    + 197 x^22 + 181 x^23 + 233 x^24 + 211 x^25 + 273 x^26 + 241 x^27 + 310 x^28 + 275 x^29 + 348 x^30 \
    + 305 x^31 + 389 x^32 + 335 x^33 + 426 x^34 + 368 x^35 + 463 x^36 + 396 x^37 + 505 x^38 + 424 x^39 \
    + 541 x^40 + 456 x^41 + 577 x^42 + 481 x^43 + 615 x^44 + 503 x^45 + 642 x^46 + 526 x^47 + 663 x^48 \
    + 538 x^49 + 687 x^50 + 547 x^51 + 702 x^52 + 562 x^53 + 713 x^54 + 567 x^55 + 728 x^56 + 566 x^57 \
    + 730 x^58 + 571 x^59 + 724 x^60 + 563 x^61 + 727 x^62 + 550 x^63 + 714 x^64 + 549 x^65 + 699 x^66 \
    + 535 x^67 + 695 x^68 + 517 x^69 + 676 x^70 + 511 x^71 + 652 x^72 + 488 x^73 + 640 x^74 + 464 x^75 \
    + 612 x^76 + 455 x^77 + 582 x^78 + 430 x^79 + 564 x^80 + 404 x^81 + 531 x^82 + 391 x^83 + 496 x^84 \
    + 364 x^85 + 478 x^86 + 338 x^87 + 445 x^88 + 328 x^89 + 413 x^90 + 303 x^91 + 396 x^92 + 277 x^93 \
    + 362 x^94 + 266 x^95 + 327 x^96 + 240 x^97 + 311 x^98 + 215 x^99 + 281 x^100 + 207 x^101 + 251 x^102\
    + 184 x^103 + 238 x^104 + 159 x^105 + 210 x^106 + 153 x^107 + 181 x^108 + 133 x^109 + 173 x^110 \
    + 113 x^111 + 148 x^112 + 112 x^113 + 126 x^114 + 94 x^115 + 122 x^116 + 77 x^117 + 102 x^118 \
    + 77 x^119 + 85 x^120 + 62 x^121 + 83 x^122 + 51 x^123 + 68 x^124 + 53 x^125 + 56 x^126 + 41 x^127\
    + 55 x^128 + 32 x^129 + 44 x^130 + 33 x^131 + 33 x^132 + 25 x^133 + 35 x^134 + 19 x^135 + 27 x^136 \
    + 21 x^137 + 20 x^138 + 15 x^139 + 23 x^140 + 10 x^141 + 15 x^142 + 13 x^143 + 10 x^144 + 9 x^145\
    + 13 x^146 + 5 x^147 + 9 x^148 + 7 x^149 + 6 x^150 + 4 x^151 + 7 x^152 + x^153 + 4 x^154 + 4 x^155 \
    + x^156 + 2 x^157 + 4 x^158 + 2 x^160 + 2 x^161 + 2 x^164 + x^167 + x^170;
PolynomialMod[fx, x^100] ~ PolynomialMod ~ (x - 1)

# P110: 丢番图倒数 II

Diophantine reciprocals II

在如下方程中, 均为正整数.

对于 , 上述方程恰好有 个不同的解:

\begin{aligned} \frac{1}{5}+\frac{1}{20}&=\frac{1}{4}\\ \frac{1}{6}+\frac{1}{12}&=\frac{1}{4}\\ \frac{1}{8}+\frac{1}{8}&=\frac{1}{4}\\ \end{aligned}

可以验证当 时, 恰好有 种不同的解, 这也是不同的解的总数超过一百种的最小 值.

不同的解的总数超过四百万种的最小 值是多少?

这题比 P108 高到不知道哪里去了, 我难道还能逆解欧拉函数不成...

, 我看看能不能递归, 欧拉函数是乘性函数, 说不定找一堆小点的因数就能试出来了.

其实可以搞个上界出来:

然而并没有什么卵用.

种种迹象表明这个解大的惊人.

我们可以设计一个拉斯维加斯算法, 找一堆素因子, 然后计算

可想而知最好前面的小因子比较大, 后面的大因子补 1 就行.

这样乘出来的数字就比较小, 而因子乘起来比较大.

然后试啊试, 试的多了就能找到这个数......

ls = PadRight[IntegerPartitions[#, 12]] /. {0 -> 1}&;
(*ct=(DivisorSigma[0,Times@@(Array[Prime,Length@#]^(2#))]+1)/2&*)
all = Table[{# -> Fold[2 ## + ##&, 0, #] + 1}& /@ ls[i], {i, 20}] // Flatten;
fliter = SortBy[Select[all, Last@#> 4*^6&], Last]
Times@@(Array[Prime, Length@#]^#)&[fliter[[1, 1]]]

其实算到幂和为 就出来了, 不过我猜的 位, 比较保险.

CenterDot@@(Superscript@@@FactorInteger[%]) 格式化得到最终结果是:

相应的解得个数高达

回头想想也不是很难, 就是很难想到要用随机算法.

中间还查了一次 OEIS, 浪费了不少时间, 以后还是自己想比较快.

编号 计时
P101 2:15
P102 17:23
P103 31:10
P104 9:00
P105 10:45
P106 9:49
P107 7:13
P108 27:50
P109 72:14
P110 59:21

← Level111-120 →