Project Euler (41–50)

41. Pandigital prime

We shall say that an n-digit number is pandigital if it makes use of all the digits 1 to n exactly once. For example, 2143 is a 4-digit pandigital and is also prime.
What is the largest n-digit pandigital prime that exists?

两层 Do 循环从大到小遍历所有排列，找到素数后用 Throw 跳出并由 Catch 捕获——Wolfram Language 其实也能写得这么过程式。

Catch @ Do[
  With[{perm = Permutations @ Range @ n},
    Do[If[PrimeQ @ #, Throw[#]] & @ FromDigits @ perm[[-i]], {i, n!}]
  ],
  {n, Range[9, 1, -1]}
]
(* 7652413 *)

想一下可以知道，n 取 8 或 9 时生成的排列一定能被 3 整除，所以外层循环可以直接从 7 开始。这样能快五千多倍吧。

42. Coded triangle numbers

The n^th term of the sequence of triangle numbers is given by, t_n=\frac12n(n+1); so the first ten triangle numbers are:
1, 3, 6, 10, 15, 21, 28, 36, 45, 55, …
By converting each letter in a word to a number corresponding to its alphabetical position and adding these values we form a word value. For example, the word value for SKY is 19 + 11 + 25 = 55 = t₁₀. If the word value is a triangle number then we shall call the word a triangle word.
Using words.txt (right click and ‘Save Link/Target As…’), a 16K text file containing nearly two-thousand common English words, how many are triangle words?

解一下方程：

t_n = \frac{n(n+1)}{2} \implies n = \frac{-1\pm\sqrt{8t_n + 1}}{2}.

因此只要判断 \sqrt{8t_n + 1} 是否为奇数即可。

With[{data = Import["https://projecteuler.net/project/resources/p042_words.txt", "String"]},
  Count[_?(OddQ @ Sqrt[1 + 8 * Total[ToCharacterCode[#] - 64]] &)] @
    StringSplit[StringDelete[data, "\""], ","]]
(* 162 *)

43. Sub-string divisibility

The number, 1406357289, is a 0 to 9 pandigital number because it is made up of each of the digits 0 to 9 in some order, but it also has a rather interesting sub-string divisibility property.
Let d₁ be the 1^st digit, d₂ be the 2^nd digit, and so on. In this way, we note the following:
d₂d₃d₄ = 406 is divisible by 2
d₃d₄d₅ = 063 is divisible by 3
d₄d₅d₆ = 635 is divisible by 5
d₅d₆d₇ = 357 is divisible by 7
d₆d₇d₈ = 572 is divisible by 11
d₇d₈d₉ = 728 is divisible by 13
d₈d₉d₁₀ = 289 is divisible by 17
Find the sum of all 0 to 9 pandigital numbers with this property.

从右往左看。先列出所有三位数的 17 的倍数：

last3 = Select[IntegerDigits[17 * Range[100]],
  100 < FromDigits[#] < 1000 && DuplicateFreeQ[#] &];

然后取前两位再加一个数字，并从中选择出 13 的倍数。注意三位数的 13 的倍数后两位是不重复的，因此可以省点事：

$last4 = Function[digits, Select[Divisible[#, 13] &] @
  (FromDigits[Prepend[Take[digits, 2], #]] & /@ Complement[Range[0, 9], digits])] /@ last3;

这样就得到了所有可能的后四位：

last4 = Module[{foo},
  foo[_, {}]    := Nothing;
  foo[a_, {b_}] := Prepend[a, First @ IntegerDigits[b, 10, 3]];
  MapThread[foo, {last3, $last4}]
];

剩下 6 个数字，6! = 720，直接枚举问题不大。列出所有排列，再判断各划分是否可以被对应的素数整除：

primesDivisible[perm_] := And @@
  MapThread[Divisible, {FromDigits /@ Partition[Take[perm, {2, 8}], 3, 1], Prime @ Range[5]}]
FromDigits /@ Select[primesDivisible] @ Catenate @
  Map[Function[list, Flatten[{#, list}] & /@ Permutations @ Complement[Range[0, 9], list]],
    last4] // Total
(* 16695334890 *)

44. Pentagon numbers

Pentagonal numbers are generated by the formula, P_n = n(3n − 1)/2. The first ten pentagonal numbers are:
1, 5, 12, 22, 35, 51, 70, 92, 117, 145, …
It can be seen that P₄ + P₇ = 22 + 70 = 92 = P₈. However, their difference, 70 − 22 = 48, is not pentagonal.
Find the pair of pentagonal numbers, P_j and P_k, for which their sum and difference are pentagonal and D = |P_k - P_j| is minimised; what is the value of D?

列出所有的五边形数然后求和、作差并判断。判断是否为五边形数，就是倒过去解方程，从 P_n 求出 n，再检查 n 是否为整数。问题在于 IntegerQ 实在是慢得令人发指，只能写点啰嗦的代码编译一下了。

pentagonNumberQ = Compile[{{n, _Integer}},
  ((Round[(1 + Sqrt[24n + 1]) / 6] * 6 - 1)^2 - 1) / 24 == n,
  CompilationTarget -> "C"];
Abs @* Subtract @@ First @
  Select[Apply[pentagonNumberQ[#1 + #2] && pentagonNumberQ[#2 - #1] &]] @
    Subsets[Array[# * (3# - 1) / 2 &, 2200], {2}] // AbsoluteTiming
(* {6.117238, 5482660} *)

45. Triangular, pentagonal, and hexagonal

Triangle, pentagonal, and hexagonal numbers are generated by the following formulae:
Triangle T_n = n(n+1)/2 1, 3, 6, 10, 15, …
Pentagonal P_n = n(3n−1)/2 1, 5, 12, 22, 35, …
Hexagonal H_n = n(2n−1) 1, 6, 15, 28, 45, …
It can be verified that T₂₈₅ = P₁₆₅ = H₁₄₃ = 40755.
Find the next triangle number that is also pentagonal and hexagonal.

取一个合理的上界，枚举、取交集。

Intersection @@ Outer[PolygonalNumber, {3, 5, 6}, Range[1*^5]] // Last
(* 1533776805 *)

46. Goldbach’s other conjecture

It was proposed by Christian Goldbach that every odd composite number can be written as the sum of a prime and twice a square.
9 = 7 + 2×1²
15 = 7 + 2×2²
21 = 3 + 2×3²
25 = 7 + 2×3²
27 = 19 + 2×2²
33 = 31 + 2×1²
It turns out that the conjecture was false.
What is the smallest odd composite that cannot be written as the sum of a prime and twice a square?

goldbachOddQ 函数依据猜想计算，检查 \sqrt{(n-p)/2}（p 为素数）是否为整数。然后遍历所有奇数找到最小的反例。

goldbachOddQ[n_] := MemberQ[Sqrt[(n - Prime @ Range @ PrimePi[n]) / 2], _Integer]
NestWhile[# + 2 &, 3, goldbachOddQ, 1] // AbsoluteTiming
(* {6.424164, 5777} *)

47. Distinct primes factors

The first two consecutive numbers to have two distinct prime factors are:
14 = 2 × 7
15 = 3 × 5.
The first three consecutive numbers to have three distinct prime factors are:
644 = 2² × 7 × 23
645 = 3 × 5 × 43
646 = 2 × 17 × 19.
Find the first four consecutive integers to have four distinct prime factors each. What is the first of these numbers?

PrimeNu 函数可以直接获得不同素因子的个数，接着打表、划分再查找就好了。不过 PrimeNu 比 Length @* FactorInteger 慢了将近十倍？这优化没做好啊。

First @ FirstPosition[{4, 4, 4, 4}] @
  Partition[PrimeNu[Range[15*^4]], 4, 1] // AbsoluteTiming
(* {3.85717, 134043} *)

First @ FirstPosition[{4, 4, 4, 4}] @
  Partition[Length /@ FactorInteger[Range[15*^4]], 4, 1] // AbsoluteTiming
(* {0.40695, 134043} *)

48. Self powers

The series, 1¹ + 2² + 3³ + … + 10¹⁰ = 10405071317.
Find the last ten digits of the series, 1¹ + 2² + 3³ + … + 1000¹⁰⁰⁰.

1000¹⁰⁰⁰ 也没多大，直接算：

Mod[Sum[i^i, {i, 1000}], 1*^10]
(* 9110846700 *)

49. Prime permutations

The arithmetic sequence, 1487, 4817, 8147, in which each of the terms increases by 3330, is unusual in two ways: (i) each of the three terms are prime, and, (ii) each of the 4-digit numbers are permutations of one another.
There are no arithmetic sequences made up of three 1-, 2-, or 3-digit primes, exhibiting this property, but there is one other 4-digit increasing sequence.
What 12-digit number do you form by concatenating the three terms in this sequence?

列出所有 1000–9999 之间的素数
按照各位数字是否构成置换分组
为每组生成长度为 3 的置换，找到构成等差数列的组合
转换为字符串并连接

StringJoin @* IntegerString /@ Catenate @
  (Select[Permutations[#, {3}], Apply[Equal] @* Differences] & /@ Select[Length[#] >= 3 &] @
    GatherBy[Prime @ Range[#1 + 1, #2] & @@ PrimePi @ {1000, 10000}, Union @* IntegerDigits])
(* {148748178147, 814748171487, 296962999629, 962962992969} *)

50. Consecutive prime sum

The prime 41, can be written as the sum of six consecutive primes:
41 = 2 + 3 + 5 + 7 + 11 + 13
This is the longest sum of consecutive primes that adds to a prime below one-hundred.
The longest sum of consecutive primes below one-thousand that adds to a prime, contains 21 terms, and is equal to 953.
Which prime, below one-million, can be written as the sum of the most consecutive primes?

依次从 2, 3, … 开始往后加，找到最长的连续素数片段。大概最多只要 600 个素数相加就能超过 10⁶，所以 Table 中并不会有太多项。起始位置取到 10 就足够，再往后连续素数片段的长度便开始下降了。UpTo 可以防止下标越界，比较实用。

First @ MaximalBy[Last] @ With[{pRange = Prime[Range[600]]},
  Table[Last @ Select[PrimeQ @ Last[#] && Last[#] < 1*^6 &] @
      Map[{i, #, Total @ Take[pRange, {i, UpTo[i + # - 1]}]} &, Range[600]],
    {i, 10}]]
(* {4, 543, 997651} *)

最后得到的 997651 是 7, 11, …, 3931 这 543 个素数之和。

Triangle	T_n = n(n+1)/2	1, 3, 6, 10, 15, …
Pentagonal	P_n = n(3n−1)/2	1, 5, 12, 22, 35, …
Hexagonal	H_n = n(2n−1)	1, 6, 15, 28, 45, …

41. Pandigital prime ​

42. Coded triangle numbers ​

43. Sub-string divisibility ​

44. Pentagon numbers ​

45. Triangular, pentagonal, and hexagonal ​

46. Goldbach’s other conjecture ​

47. Distinct primes factors ​

48. Self powers ​

49. Prime permutations ​

50. Consecutive prime sum ​