## 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?

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


## 42. Coded triangle numbers

The nth term of the sequence of triangle numbers is given by, tn = 1/2 n(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 = t10. 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}.$

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 d1 be the 1st digit, d2 be the 2nd digit, and so on. In this way, we note the following:

• d2d3d4 = 406 is divisible by 2
• d3d4d5 = 063 is divisible by 3
• d4d5d6 = 635 is divisible by 5
• d5d6d7 = 357 is divisible by 7
• d6d7d8 = 572 is divisible by 11
• d7d8d9 = 728 is divisible by 13
• d8d9d10 = 289 is divisible by 17

Find the sum of all 0 to 9 pandigital numbers with this property.

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


$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}]
];


primesDivisible[perm_] := And @@
MapThread[Divisible, {FromDigits /@ Partition[Take[perm, {2, 8}], 3, 1], Prime @ Range}]
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, Pn=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 P4 + P7 = 22 + 70 = 92 = P8. However, their difference, 70 − 22 = 48, is not pentagonal.

Find the pair of pentagonal numbers, Pj and Pk, for which their sum and difference are pentagonal and D = |Pk - Pj| is minimised; what is the value of D?

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 Tn=n(n+1)/2 1, 3, 6, 10, 15, … Pentagonal Pn=n(3n−1)/2 1, 5, 12, 22, 35, … Hexagonal Hn=n(2n−1) 1, 6, 15, 28, 45, …

It can be verified that T285 = P165 = H143 = 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 函数可以直接获得不同素因子的个数，接着打表、划分再查找就好了。不过 PrimeNuLength @* FactorInteger 慢了将近十倍？这优化没做好啊。

First @ FirstPosition[{4, 4, 4, 4}] @
(* {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?

1. 列出所有 1000–9999 之间的素数
2. 按照各位数字是否构成置换分组
3. 为每组生成长度为 3 的置换，找到构成等差数列的组合
4. 转换为字符串并连接
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?

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