P91: 格点直角三角形

# P91: 格点直角三角形

Right triangles with integer coordinates

点和点都是格点, 并与原点构成 .

当点和点的所有坐标都在到之间, 也就是说时, 恰好能构造出个直角三角形.

如果 , 能构造出多少个直角三角形?

看到这种题第一反应就是生成函....

那啥.... 我又看出规律了.....

编号 1-14, 对于的正方形, 首先有三种简单的情况, 就是以及这种直角在角上的.

到手.

不在角上的就比较麻烦了...

画个草图

设直角那个叫 . 然后就是 .

\begin{aligned} &\because OP \bot PQ \\ &\therefore \overrightarrow{OP} \cdot \overrightarrow{PQ} = 0 \\ &\Rightarrow {x_1}{x_2} + {y_1}{y_2} = x_1^2 + y_1^2 \end{aligned}

化简下, 于是就从几何问题转化为了代数问题, 求这个的整数解.

这时候开始穷举也行, 不过还能化简公式.

\begin{aligned} &\quad\ \begin{cases} x_2=x_1+a\\ y_2=y_1+b\\ \end{cases}\\ &\Rightarrow ax_1+by_1=0\\ \end{aligned}

于是有:

\begin{aligned} &\quad\ d=GCD(x_1,y_1)\\ &\Rightarrow(a,b)=(-\frac{y_1}{d}n,\frac{x_1}{d}n)\\ &\Rightarrow f(s)=\min\left(\frac{y_1}{x_1}d,\frac{s-x_1}{y_1}d\right)\\ &\Rightarrow S=\sum\limits_{0<x_1,y_1<s}f(s)+3s^2 \end{aligned}

翻译成代码, 根据对称性卡死 , 这样还可以少一半计算量, 最后乘以 2 补回去.

Function[s, 2 Total[Array[Min@Quotient[{#2, s - #}, {##} / GCD@##]&, {s, s}], 2] + 3 s^2]@50

# 92: 平方数字链

Square digit chains

将一个数的所有数字的平方相加得到一个新的数, 不断重复直到新的数已经出现过为止, 这构成了一条数字链.

例如,

可见, 任何一个到达或的数字链都会陷入无尽的循环.

更令人惊奇的是, 从任意数开始, 最终都会到达或 .

有多少个小于一千万的数最终会到达 ?

硬计算差评, 还有我又一次没看到小于号..... 虽然不影响结果...

foo = Total[IntegerDigits[#]^2]&;
bar[1] = 1;bar[89] = 89;bar[n_] := bar[n] = bar@foo@n
Tally[ParallelMap[bar, Range[1*^7]]]

# P93: 算术表达式

Arithmetic expressions

使用集合中每个数字恰好一次以及四则运算和括号, 可以得到不同的正整数.

例如,

8 = (4 * (1 + 3)) / 2
14 = 4 * (3 + 1 / 2)
19 = 4 * (2 + 3) − 1
36 = 3 * 4 * (2 + 1)

注意不允许直接把数字连起来, 如 .

使用集合 , 可以得到个不同的数, 其中最大值是 , 以及之间所有的数.

若使用包含有四个不同数字的集合可以得到从之间所有的数;

求其中使得最大的集合, 并将你的答案写成字符串: .

9 个数字选 4 个, C(9,4)=126.

四个符号选三个 C(4,3)=4

7 个位子 8 个空选两个放括号 C(8,2)=28

全部乘起来也不大...

没括号的 64 种情况下是这样的, 好吧我就是想秀一下我珍藏多年的强力函数.....

ListToExpression[list_] := list //. ({x___, PatternSequence[a_, u : #, b_], y___} :> {x, u[a, b], y}& /@ {Power | Log | Surd, Times | Divide, Plus | Subtract});
OperatorRiffle[exp_, oper_ : {Times, Divide, Plus, Subtract}] := Grid[{#, ListToExpression@#}& /@ (Riffle[exp, #]& /@ Tuples[oper, Length@exp - 1]), Alignment -> Left];
OperatorRiffle[{a, b, c, d}]

虽然后来我想到这个其实直接变字符串然后连起来然后读回表达式就行....

不过那样就无法装逼了...

而且这个方法对于 Log, Surd 这类非算子也有效, 强制解释为最高级算子.

而且运算优先级完全可以魔改, 我就是规定加法优先乘法怎么着.....

注意相减算子是 SubMinus, Minus 是取负, 不是个算子.

MinusPlus, PlusMinus 正负号, 负正号这俩就连运算都不是了, 只是个保留符号罢了.

Ok, 回到这道题, 不管怎么样我们就考虑怎么穷举出的所有计算结果好了.

AllResults[L_] := If[Length[L] == 1, L, DeleteDuplicates@Flatten@Table[With[{c = AllResults@DeleteCases[L, x]}, {x + c, x - c, x * c, x / c, c / x, c - x}], {x, L}]];
FinalResults[L_] := Sort@Select[AllResults[L], IntegerQ[#] && # > 0&];
SeqLength[L_] := With[{res = FinalResults@L}, If[Length@res == 0 || First@res != 1, 0, First@FirstPosition[Differences@res, x_ /; x != 1]]];
MaximalBy[Subsets[Range[9], {4}], SeqLength]

# P94: 几乎等边的三角形

Almost equilateral triangles

可以证明, 不存在边长为整数的等边三角形其面积也是整数.

但是, 存在几乎等边的三角形 , 其面积恰好为 .

我们定义几乎等边的三角形是有两条边一样长, 且第三边与这两边最多相差的三角形.

对于所有边长和面积均为整数且周长不超过十亿的三角形, 求其中几乎等边的三角形的周长之和.

底边不能是奇数, 否则面积就会变成无理数.

设底边是 , 腰就是 , 周长就是 ;

所以的范围就出来了, 然后只要判定高是否是整数就行了.

大概像这样

Select[Table[Sqrt[#1], {n, 1*^6 / 3}], FractionalPart[#] == 0&]& /@ {1.0 - 4n + 5n^2, 1.0 + 4n + 5n^2}

不行啊, 周长 10 亿呢, 得找个更强的公式...

设三边分别是

\begin{aligned} S&=\frac{n+1}{4}\sqrt{3n^2-2n-1}\\ &\Rightarrow3n^2-2n-1=y^2\\ &\Rightarrow n=\frac{1\pm\sqrt{3y^2+4}}{3}\\ &\Rightarrow{x^2}-3y^2=4,(x,y)\in{N_+} \end{aligned}

佩尔方程咯.....

Reduce[{x^2 - 3y^2 == 4, x > 0, y > 0}, {x, y}, Integers]

(14,8) 对应的是 (5,5,6) 差了一项, 要位移一格...

\begin{cases} x_{i+1}=\left(2-\sqrt3\right)^i+\left(2+\sqrt3\right)^i\\ y_{i+1}=\dfrac{\left(2+\sqrt3\right)^i-\left(2-\sqrt3\right)^i}{\sqrt3}\\ \end{cases}

或者写成矩阵式就是

$$ \begin{bmatrix}x_i \ y_i\end{bmatrix} =\begin{bmatrix}2&3 \ 1&2\end{bmatrix}^i \begin{bmatrix}4 \ 2\end{bmatrix} $$

然后代回原来的式子就行.

作同样的推导也是这个式子, 这倒是省心了.

公式在手别说 10 亿了, 10 亿的平方都不怕了...

list = Most@NestWhileList[{{2, 3}, {1, 2}}.#&, {14, 8}, #[[1]] < 1*^9 - 1&];
Total@Map[If[Mod[First@#, 3] == 1, First@# - 2, First@# + 2]&, list]

# P95: 亲和数链

Amicable chains

一个数除了本身之外的因数称为真因数.

例如, 的真因数是 . 这些真因数的和恰好为 28, 因此我们称 28 是完全数.

有趣的是, 的真因数之和是 , 同时的真因数之和是 , 构成了一个长度为的链, 我们也称之为亲和数对.

有一些更长的序列并不太为人所知. 例如, 从出发, 可以构成一个长度为的链:

由于这条链最后又回到了起点, 我们称之为亲和数链.

找出所有元素都不超过一百万的亲和数链中最长的那条, 并给出其中最小的那个数.

第一反应, FindCycle

FindCycle[Graph@Table[DirectedEdge[i, DivisorSigma[1, i] - i], {i, 1, 1*^4}], Infinity]

然后大点就爆了.....

Well, 换个函数就好, 比如 ConnectedComponents.....

data = Table[DirectedEdge[i, DivisorSigma[1, i] - i], {i, 1*^6 - 1}];
gra = GatherBy[ConnectedComponents@Graph@data, Length];
First[Sort@@Last@gra]

# P96: 数独

::: Su Doku 数独 (日语原意为数的位置) 是一种热门的谜题.

它的起源已不可考, 但是与欧拉发明的一种类似而更加困难的谜题拉丁方阵之间有着千丝万缕的联系.

数独的目标是替换掉网格中的空白位置, 使得每行, 每列以及每个九宫格中恰好都包含数字 .

一个构造精良的数独谜题应该包含有唯一解, 且能够通过逻辑推断来解决, 尽管有时可能必须通过 "猜测并检验" 来排除一些选项 (这一要求目前还颇受争议).

寻找答案的复杂度决定了题目的难度;

上面这个谜题被认为是简单的谜题, 因为我们可以通过直截了当的演绎推理来解决它.

在这个 6K 的文本文件 sudoku.txt 中包含有 50 个不同难度的数独谜题, 但保证它们都只有唯一解 (文件中的第一个谜题就是上述样例).

解开这 50 个谜题, 找出每个谜题解答左上角的三个数字并连接起来, 给出这些数的和;

举例来说, 上述样例解答左上角的三个数字连接起来构成的数是 483. :::

按例跳过未计时, 另外回溯会超时, 最好写逻辑判别.

Get["https://raw.githubusercontent.com/GalAster/BiGridGenerator/master/BiGridGenerator/Kernel/Game/OtherGames.m"];
dat=Partition[ReadList["https://projecteuler.net/project/resources/p096_sudoku.txt",Byte,RecordLists->True],9,10,-10]-48;
First@First@Flatten[Total[FromDigits/@OtherGames`SudokuSolverFast/@dat],1]

# P97: 非梅森大素数

Large non-Mersenne prime

1999 年人们发现了第一个超过一百万位的素数, 这是一个梅森素数, 可以表示为 , 包含有位数字.

在此之后, 更多形如的梅森素数被发现, 其位数也越来越多.

然而, 在 2004 年, 人们发现了一个巨大的非梅森素数, 包含有位数字: .

找出这个素数的最后十位数字.

快速幂模, 水过....

Mod[28433PowerMod[2, 7830457, 1*^10] + 1, 1*^10]

# P98: 重排平方数

Anagramic squares

将单词 CARE 中的四个字母依次赋值为 1, 2, 9, 6, 我们得到了一个平方数: 1296 = 362.

神奇的是, 使用同样的数字赋值, 重排后的单词 RACE 同样构成了一个平方数: 9216 = 962.

我们称 CARE 和 RACE 为重排平方单词对, 同时规定这样的单词对不允许有前导零或是不同的字母赋相同的值.

在这个 16K 的文本文件 words.txt 中包含了将近两千个常见英文单词, 找出所有的重排平方单词对 (一个回文单词不视为它自己的重排).

重排平方单词对所给出的最大平方数是多少?

注意: 所有的重排单词必须出现在给定的文本文件中.

没做出来... 放弃....

本来以为 So easy 的, 直接照着说明写一遍就好了, 结果发现赋值情况有点多, 直接上估计跑到明天都跑不完...

data = Import["https://projecteuler.net/project/resources/p098_words.txt", "CSV"][[1]];
selected = Select[Split[Sort[{Tally[Sort[Characters[#]]], #}& /@ data], First[#1] == First[#2]&], Length@# > 1&];
Anagrams = Reverse[selected[[All, All, 2]]] /. {a_, b_, c_} -> Sequence[{a, b}, {b, c}, {a, c}];
(*SP=SequencePermutation*)
SP[a : {_String, _String}] := Block[
    {per, sqn, l},
    per = FindPermutation[Sequence@@Characters /@ a];
    l = StringLength[First@a];
    sqn = Select[
        #^2& /@ Range[Floor[Sqrt[10^(l - 1)] + 1], Floor[Sqrt[10^(l) - If[EvenQ[l], 1, 0]]]],
        Tally[Characters[First@a]][[All, 2]] == Tally[IntegerDigits[#]][[All, 2]]&
    ];
    {a, Select[{#, FromDigits@(Permute[IntegerDigits@#, per])}& /@ sqn, MemberQ[sqn, #[[2]]] && #[[1]] != #[[2]]&]}
];
MaximalBy[Select[SP /@ Anagrams, Last@# != {}&], Last@Last@#&]

# P99: 最大的幂

Largest exponential

比较两个如 211 和 37 这样写成幂的形式的数并不困难, 任何计算器都能验证 211 = 2048 < 37 = 2187.

然而, 想要验证 632382518061 > 519432525806 就会变得非常困难, 因为这两个数都包含有超过三百万位数字.

22K 的文本文件 base_exp.txt 有一千行, 每一行有一对底数和指数, 找出哪一行给出的幂的值最大.

注意: 文件的前两行就是上述两个例子.

高精计算, 哦不, 其实就是取个对数.... 真水.....

data=Import["https://projecteuler.net/project/resources/p099_base_exp.txt","CSV"];
Last@Ordering[N[#2 Log[#1]]&@@@data]

# P100: 安排概率

Arranged probability

在一个盒子中装有 21 个彩色碟子, 其中 15 个是蓝的, 6 个是红的.

如果随机地从盒子中取出两个碟子, 取出两个蓝色碟子的概率是 .

下一组使得取出两个蓝色盘子的概率恰好为的安排, 是在盒子中装有 85 个蓝色碟子和 35 个红色碟子.

当盒子中装有超过个碟子时, 找出第一组满足上述要求的安排, 并求此时盒子中蓝色碟子的数量.

\begin{cases} \dfrac{B(B-1)}{N(N-1)}=\dfrac{1}{2}\\ 0<B<10^{12}<N \end{cases}

有点懵逼, 简单过头了吧放这, 大概是 100 题了给你们庆祝下.....

Reduce[0<b<10^12<n&&2 b(b-1)==n(n-1),{b,n},Integers]

58 分 30 秒, 欧耶, 一小时内搞定, 也就 P93 比较麻烦, 其他稍微推导一下都能有思路. P96 未计时, P98 放弃.

← Level81-90 Level101-110 →