61. Cyclical figurate numbers

Triangle, square, pentagonal, hexagonal, heptagonal, and octagonal numbers are all figurate (polygonal) numbers and are generated by the following formulae:

 Triangle P3,n\ =\ n(n+1)/2 1, 3, 6, 10, 15, … Square P4,n\ =\ n² 1, 4, 9, 16, 25, … Pentagonal P5,n\ =\ n(3n−1)/2 1, 5, 12, 22, 35, … Hexagonal P6,n\ =\ n(2n−1) 1, 6, 15, 28, 45, … Heptagonal P7,n\ =\ n(5n−3)/2 1, 7, 18, 34, 55, … Octagonal P8,n\ =\ n(3n−2) 1, 8, 21, 40, 65, …

The ordered set of three 4-digit numbers: 8128, 2882, 8281, has three interesting properties.

1. The set is cyclic, in that the last two digits of each number is the first two digits of the next number (including the last number with the first).
2. Each polygonal type: triangle (P3,127 = 8128), square (P4,91 = 8281), and pentagonal (P5,44 = 2882), is represented by a different number in the set.
3. This is the only set of 4-digit numbers with this property.

Find the sum of the only ordered set of six cyclic 4-digit numbers for which each polygonal type: triangle, square, pentagonal, hexagonal, heptagonal, and octagonal, is represented by a different number in the set.

polygonalNumberSolve[r_] :=
n /. Solve[1000 <= PolygonalNumber[r, n] < 10000, n, PositiveIntegers]
polygonalNumbers = Association @@ Table[
r -> QuotientRemainder[#, 100] & @
Select[Mod[#, 100] >= 10 &] @
PolygonalNumber[r, polygonalNumberSolve[r]],
{r, 3, 8}
];


Length /@ polygonalNumbers
(* <|3 -> 88, 4 -> 53, 5 -> 47, 6 -> 44, 7 -> 40, 8 -> 30|> *)
Times @@ %
(* 11574182400 *)


def back_track(nums, s):
if not nums:
return True

prev_j = s[-1][1]

for r, tuples in nums.items():
for i, j in filter(lambda t: t[0] == prev_j, tuples):
temp_nums = nums.copy()
temp_nums.pop(r)
temp_res = s.copy()
s.append((i, j))
if back_track(temp_nums, s):
if s[0][0] == s[-1][1]:
res = [x * 100 + y for (x, y) in s]
print(res)
print(sum(res))
s = temp_res
return False

r0 = next(iter(POLYGONAL_NUMBERS))
for i, j in POLYGONAL_NUMBERS[r0]:
numbers = POLYGONAL_NUMBERS.copy()
numbers.pop(r0)
back_track(numbers, s=[(i, j)])


pythonCode = "
POLYGONAL_NUMBERS = <* polygonalNumbers *>
...
";
ExternalEvaluate["Python", pythonCode]
(* [8256, 5625, 2512, 1281, 8128, 2882] *)
(* 28684 *)


62. Cubic permutations

The cube, 41063625 (345³), can be permuted to produce two other cubes: 56623104 (384³) and 66430125 (405³). In fact, 41063625 is the smallest cube which has exactly three permutations of its digits which are also cube.

Find the smallest cube for which exactly five permutations of its digits are cube.

Min @ Values @ Select[Length[#] == 5 &] @
GroupBy[Range[10000]^3, Sort @* IntegerDigits]
(* 127035954683 *)


63. Powerful digit counts

The 5-digit number, 16807=7⁵, is also a fifth power. Similarly, the 9-digit number, 134217728=8⁹, is a ninth power.

How many n-digit positive integers exist which are also an nth power?

$10^{n-1} \leqslant a^n < 10^n \text{ and } a \in \mathbb{N}^* \implies 10^{1-1/n} \leqslant 9 \implies n \leqslant \frac{\log10}{\log(10/9)} \simeq 21.8543$

Count[_?(Apply[IntegerLength[#3] == #2 &])] @
Catenate @ Outer[{#1, #2, #1^#2} &, Range[9], Range[21]]
(* 49 *)


64. Odd period square roots

All square roots are periodic when written as continued fractions and can be written in the form:

$\sqrt{N} = a_0 + \frac{1}{a_1 + \frac{1}{a_2 + \frac{1}{a_3+\cdots}}}$

For example, let us consider $\sqrt{23}$:

$\sqrt{23} = 4 + \sqrt{23} - 4 = 4 + \frac{1}{\frac{1}{\sqrt{23} - 4}} = 4 + \frac{1}{1 + \frac{\sqrt{23}-3}{7}}$

If we continue we would get the following expansion:

$\sqrt{23} = 4 + \frac{1}{1 + \frac{1}{3 + \frac{1}{1 + \frac{1}{8+\cdots}}}}$

The process can be summarised as follows:

\begin{aligned} a_0 &= 4, \enspace \frac{1}{\sqrt{23}-4} = \frac{ \sqrt{23}+4 }{ 7} = 1 + \frac{\sqrt{23}-3}{7} \\ a_1 &= 1, \enspace \frac{7}{\sqrt{23}-3} = \frac{7(\sqrt{23}+3)}{14} = 3 + \frac{\sqrt{23}-3}{2} \\ a_2 &= 3, \enspace \frac{2}{\sqrt{23}-3} = \frac{2(\sqrt{23}+3)}{14} = 1 + \frac{\sqrt{23}-4}{7} \\ a_3 &= 1, \enspace \frac{7}{\sqrt{23}-4} = \frac{7(\sqrt{23}+4)}{ 7} = 8 + \sqrt{23}-4 \\ a_4 &= 8, \enspace \frac{1}{\sqrt{23}-4} = \frac{ \sqrt{23}+4 }{ 7} = 1 + \frac{\sqrt{23}-3}{7} \\ a_5 &= 1, \enspace \frac{7}{\sqrt{23}-3} = \frac{7(\sqrt{23}+3)}{14} = 3 + \frac{\sqrt{23}-3}{2} \\ a_6 &= 3, \enspace \frac{2}{\sqrt{23}-3} = \frac{2(\sqrt{23}+3)}{14} = 1 + \frac{\sqrt{23}-4}{7} \\ a_7 &= 1, \enspace \frac{7}{\sqrt{23}-4} = \frac{7(\sqrt{23}+4)}{ 7} = 8 + \sqrt{23}-4 \end{aligned}

It can be seen that the sequence is repeating. For conciseness, we use the notation $\sqrt{23} = [4;\,(1,3,1,8)]$, to indicate that the block (1,3,1,8) repeats indefinitely.

The first ten continued fraction representations of (irrational) square roots are:

$\sqrt{2} = [1;\,(2)]$, period = 1 $\sqrt{3} = [1;\,(1,2)]$, period = 2 $\sqrt{5} = [2;\,(4)]$, period = 1 $\sqrt{6} = [2;\,(2,4)]$, period = 2 $\sqrt{7} = [2;\,(1,1,1,4)]$, period = 4 $\sqrt{8} = [2;\,(1,4)]$, period = 2 $\sqrt{10} = [3;\,(6)]$, period = 1 $\sqrt{11} = [3;\,(3,6)]$, period = 2 $\sqrt{12} = [3;\,(2,6)]$, period = 2 $\sqrt{13} = [3;\,(1,1,1,1,6)]$, period = 5

Exactly four continued fractions, for N ≤ 13, have an odd period.

How many continued fractions for N ≤ 10000 have an odd period?

Count[{_, _?(OddQ @ Length @ # &)}] @ ContinuedFraction @ Sqrt[Range[10000]]
(* 1322 *)


65. Convergents of e

The square root of 2 can be written as an infinite continued fraction.

$\sqrt2 = 1 + \cfrac{1}{2+\cfrac{1}{2+\cfrac{1}{2+\cfrac{1}{2+\cdots}}}}$

The infinite continued fraction can be written, $\sqrt2 = [1;\,(2)]$, $(2)$ indicates that 2 repeats ad infinitum. In a similar way, $\sqrt{23} = [4;\,(1,3,1,8)]$.

It turns out that the sequence of partial values of continued fractions for square roots provide the best rational approximations. Let us consider the convergents for $\sqrt2$.

$1+\cfrac12 = \frac32, \quad 1+\cfrac{1}{2+\cfrac{1}{2}} = \frac75, \quad 1+\cfrac{1}{2+\cfrac{1}{2+\cfrac{1}{2}}} = \frac{17}{12}, \quad 1+\cfrac{1}{2+\cfrac{1}{2+\cfrac{1}{2+\cfrac{1}{2}}}} = \frac{41}{29}$

Hence the sequence of the first ten convergents for $\sqrt2$ are:

$1, \, \frac{3}{2}, \, \frac{7}{5}, \, \frac{17}{12}, \, \frac{41}{29}, \, \frac{99}{70}, \, \frac{239}{169}, \, \frac{577}{408}, \, \frac{1393}{985}, \, \frac{3363}{2378}$

What is most surprising is that the important mathematical constant,

$e = [2;\,(1,2,1,1,4,1,1,6,1,\ldots,1,2k,1,\ldots)]$

The first ten terms in the sequence of convergents for e are:

$2, \, 3, \, \frac{8}{3}, \, \frac{11}{4}, \, \frac{19}{7}, \, \frac{87}{32}, \, \frac{106}{39}, \, \frac{193}{71}, \, \frac{1264}{465}, \, \frac{1457}{536}$

The sum of digits in the numerator of the 10th convergent is 1 + 4 + 5 + 7 = 17.

Find the sum of digits in the numerator of the 100th convergent of the continued fraction for e.

Total @ IntegerDigits @ Numerator @
FromContinuedFraction @ ContinuedFraction[E, 100]
(* 272 *)


66. Diophantine equation

Consider quadratic Diophantine equations of the form:

x² – Dy² = 1

For example, when D = 13, the minimal solution in x is 649² – 13×180² = 1.

It can be assumed that there are no solutions in positive integers when D is square.

By finding minimal solutions in x for D = {2, 3, 5, 6, 7}, we obtain the following:

3² – 2×2² = 1 2² – 3×1² = 1 9² – 5×4² = 1 5² – 6×2² = 1 8² – 7×3² = 1

Hence, by considering minimal solutions in x for D ≤ 7, the largest x is obtained when D = 5.

Find the value of D ≤ 1000 in minimal solutions of x for which the largest value of x is obtained.

solve[d_] := x /. First @
FindInstance[x^2 - d * y^2 == 1, {x, y}, PositiveIntegers]
range = Complement[Range[#], Range[Sqrt @ #]^2] & @ 1000;
MaximalBy[ParallelTable[{d, solve[d]}, {d, range}], Last][[1, 1]]
(* 661 *)


67. Maximum path sum II

By starting at the top of the triangle below and moving to adjacent numbers on the row below, the maximum total from top to bottom is 23.

3 7 4 2 4 6 8 5 9 3

That is, 3 + 7 + 4 + 9 = 23.

Find the maximum total from top to bottom in triangle.txt (right click and ‘Save Link/Target As…’), a 15K text file containing a triangle with one-hundred rows.

NOTE: This is a much more difficult version of Problem 18. It is not possible to try every route to solve this problem, as there are 2⁹⁹ altogether! If you could check one trillion (10¹²) routes every second it would take over twenty billion years to check them all. There is an efficient algorithm to solve it. ;o)

maxPathSum @
Import["https://projecteuler.net/project/resources/p067_triangle.txt", "Table"]
(* 7273 *)


68. Magic 5-gon ring

Consider the following “magic” 3-gon ring, filled with the numbers 1 to 6, and each line adding to nine.

Working clockwise, and starting from the group of three with the numerically lowest external node (4,3,2 in this example), each solution can be described uniquely. For example, the above solution can be described by the set: 4,3,2; 6,2,1; 5,1,3.

It is possible to complete the ring with four different totals: 9, 10, 11, and 12. There are eight solutions in total.

Total Solution Set
9 4,2,3; 5,3,1; 6,1,2
9 4,3,2; 6,2,1; 5,1,3
10 2,3,5; 4,5,1; 6,1,3
10 2,5,3; 6,3,1; 4,1,5
11 1,4,6; 3,6,2; 5,2,4
11 1,6,4; 5,4,2; 3,2,6
12 1,5,6; 2,6,4; 3,4,5
12 1,6,5; 3,5,4; 2,4,6

By concatenating each group it is possible to form 9-digit strings; the maximum string for a 3-gon ring is 432621513.

Using the numbers 1 to 10, and depending on arrangements, it is possible to form 16- and 17-digit strings. What is the maximum 16-digit string for a “magic” 5-gon ring?

• 首先填内圈的五边形：生成全部排列，再「模掉」旋转对称性，得到 inners
• 接下来 fill 函数用来填满整个幻方，这时要利用每条旋臂数字之和相等的性质
• 然后 isValid 函数选出有效的填法：每个数字不同，且均为正整数
• 最后 toDigits 函数按照要求拼成数字串，再找到最大值即可
nGonRing[n_] := Module[
{canonicalPerm, inners, armSum, fill, isValid, toDigits},
canonicalPerm[p_] := RotateLeft[p, #] & /@ Range[n] // Sort;
inners = DeleteDuplicatesBy[canonicalPerm] @
Permutations[Range[2n], {n}];
armSum[inner_] := Total[inner] / n + 2n + 1;
fill[inner_] := With[{list = Partition[inner, 2, 1, 1]},
Reverse /@ MapThread[Append, {list, armSum[inner] - Total /@ list}]];
isValid[ring_] := With[{list = Flatten[ring]},
Length @ Union @ list == 2n && AllTrue[Positive[#] && IntegerQ[#] &] @ list];
toDigits[ring_] := FromDigits @ Flatten @ IntegerDigits @ MinimalBy[
RotateLeft[Reverse[ring], #] & /@ Range[n], #[[1, 1]] &];
toDigits /@ Select[fill /@ inners, isValid]
]
Max @ Select[# < 1*^16 &] @ nGonRing[5]
(* 6531031914842725 *)


69. Totient maximum

Euler’s Totient function, φ(n) [sometimes called the phi function], is used to determine the number of numbers less than n which are relatively prime to n. For example, as 1, 2, 4, 5, 7, and 8, are all less than nine and relatively prime to nine, φ(9)=6.

n Relatively Prime φ(n) n/φ(n)
2 1 1 2
3 1,2 2 1.5
4 1,3 2 2
5 1,2,3,4 4 1.25
6 1,5 2 3
7 1,2,3,4,5,6 6 1.1666…
8 1,3,5,7 4 2
9 1,2,4,5,7,8 6 1.5
10 1,3,7,9 4 2.5

It can be seen that n=6 produces a maximum n/φ(n) for n ≤ 10.

Find the value of n ≤ 1,000,000 for which n/φ(n) is a maximum.

EulerPhi 也是内置函数。

First @ MaximalBy[Range[1*^6], # / EulerPhi[#] &]
(* 510510 *)


70. Totient permutation

Euler’s Totient function, φ(n) [sometimes called the phi function], is used to determine the number of positive numbers less than or equal to n which are relatively prime to n. For example, as 1, 2, 4, 5, 7, and 8, are all less than nine and relatively prime to nine, φ(9)=6.

The number 1 is considered to be relatively prime to every positive number, so φ(1)=1.

Interestingly, φ(87109)=79180, and it can be seen that 87109 is a permutation of 79180.

Find the value of n, 1 < n < 10⁷, for which φ(n) is a permutation of n and the ratio n/φ(n) produces a minimum.

#[[1, 1]] & @ MinimalBy[Apply[Divide]] @
Select[Equal @@ Sort /@ IntegerDigits[#] &] @
Table[{n, EulerPhi[n]}, {n, 2, 1*^7}] // AbsoluteTiming
(* {83.527159, 8319823} *)