1

Валерий Рубанцев

Если бы у Эйлера был компьютер.
Решаем сложные и олимпиадные задачи

Все права защищены. Никакая часть этой книги не может быть воспроизведена в любой
форме без письменного разрешения правообладателей.
Автор книги не несёт ответственности за возможный вред от использования информации, составляющей содержание книги и приложений.

Copyright 2026 Валерий Рубанцев
Лилия Рубанцева
2

От автора
Не боги горшки обжигают.
В книге Если бы у Диофанта был компьютер мы решали исторические задачи по математике. Они довольно простые, поэтому хороши для тренировки, но иногда хочется и по-настоящему поломать (себе) голову. Для
этого и предназначены олимпиадные задачи. Мы не будем замахиваться
на сложные задачи международного уровня, которые скорее трудны, чем
увлекательны, а решим несколько десятков вполне олимпиадных задач, которые интересны и сами по себе, и как упражнения в практическом программировании.

Большая часть задач взята с сайта Проект Эйлер, который и дал название
этой книге. Также мы решим парочку задач, придуманных самим Эйлером.
3

Не ограничивая себя олимпиадными задачами, мы дерзнём замахнуться и
на другие, более занимательные, но тоже непростые задачи – Клайва Синклера, Станислава Улама, Крайчика, Мадахи, Гарднера, Армстронга, Пиковера и Левенштейна. В такой компании скучно не будет!
Обычно олимпиадные задачи решаются с большим трудом или не решаются вообще без какой-либо догадки. Как вовремя догадаться, не знает никто. Но, с другой стороны, есть определённый набор приёмов, которые помогают решать нестандартные задачи. И чем больше таких приёмов вы
имеете в своём арсенале, тем легче вам будет с ними справляться.
При решении задач мы будем использовать модули, которые я разработал
для этой книги. Они содержат много методов расширения и генераторов
различного рода последовательностей, поэтому пригодятся при решении
других, возможно, более сложных задач.
Эта книга только познакомит вас с огромным миром олимпиадных задач - с
надеждой, что это подтолкнёт вас к более глубокому изучению программирования на языке паскаль, который идеально подходит для решения математических задач и для быстрой разработки и отладки разнообразных проектов.
Я надеюсь, что эта книга будет полезна:
Учителям информатики и математики
Любителям различного рода задач и головоломок
Начинающим программистам и любителям программирования
Родители, которые хотели бы привлечь детей к программированию и тем
самым развить их логическое, алгоритмическое мышление.

Автор

4

Условные обозначения, принятые в книге:

Дополнение или замечание

Требование или указание

Исходный код:
begin
Writeln(' Project Euler. Problem 33');
WriteLn;
Solve;
end.

Заголовок проекта:

Проект …
Исходные коды всех проектов находятся в папке _Projects

5

Оглавление
Если бы у Эйлера был компьютер. ..................................... 2
Решаем сложные и олимпиадные задачи.............................. 2
От автора ............................................................... 3
Оглавление ............................................................. 6
Олимпийские задачи .................................................. 9
Проект
Проект
Проект
Проект
Проект

Олимпиадная задача ............................................................................... 10
Сумма чисел ................................................................................................ 11
Режем прямоугольники........................................................................... 14
Двузначные числа ..................................................................................... 19
Задача Клайва Синклера ......................................................................... 22

Project Euler ............................................................................................................... 31
Проект Эйлер001 ..................................................................................................... 34
Проект Эйлер002 ..................................................................................................... 38
Проект Эйлер003 ..................................................................................................... 43
Проект Эйлер004 ..................................................................................................... 46
Проект Эйлер005 ..................................................................................................... 54
Проект Эйлер006 ..................................................................................................... 58
Проект Эйлер007 ..................................................................................................... 61
Проект Эйлер008 ..................................................................................................... 63
Проект Эйлер009 ..................................................................................................... 74
Проект Эйлер010 ..................................................................................................... 80
Проект Эйлер011 ...................................................................................................... 83
Проект Эйлер012 ..................................................................................................... 87
Проект Эйлер013 ..................................................................................................... 93
Проект Эйлер014 ................................................................................................... 100
Проект Эйлер015 ................................................................................................... 105
Проект Эйлер016 ....................................................................................................112
Проект Эйлер017 ....................................................................................................114
Проект Эйлер018 ....................................................................................................121
Проект Эйлер067 ................................................................................................... 128
6

Проект Эйлер019 ....................................................................................................131
Проект Эйлер020 ................................................................................................... 136
Проект Эйлер021 ................................................................................................... 138
Проект Эйлер022 ................................................................................................... 146
Проект Эйлер023 ................................................................................................... 149
Проект Эйлер024 ................................................................................................... 154
Проект Эйлер025 ................................................................................................... 157
Проект Эйлер026 ....................................................................................................161
Проект Эйлер027 ................................................................................................... 166
Проект Эйлер028 ....................................................................................................171
Проект Спираль Улама ........................................................................................ 173
Проект Эйлер029 ................................................................................................... 193
Проект Эйлер030 ................................................................................................... 195
Проект Эйлер031 ................................................................................................... 198
Проект Эйлер032 .................................................................................................. 200
Проект Эйлер033 .................................................................................................. 206
Проект Эйлер034 ................................................................................................... 210
Проект Эйлер035 ................................................................................................... 214
Проект Эйлер036 ................................................................................................... 217
Проект Эйлер037 .................................................................................................. 222
Проект Эйлер038 .................................................................................................. 227
Проект Эйлер043 .................................................................................................. 233
Проект Эйлер041 .................................................................................................. 238
Проект Эйлер104 .................................................................................................. 242
Проект Эйлер142 .................................................................................................. 247
Проект
Проект
Проект
Проект
Проект
Проект
Проект
Проект
Проект

Пандигитальные квадраты .................................................................. 251
Кратные пандигитальные числа ....................................................... 258
Enigma 1436: One more step ................................................................ 262
Enigma 1496: Eighteen ........................................................................... 268
Enigma 1504: All ten digits ................................................................... 272
Enigma 1518: Sets of squares .............................................................. 286
Задача Крайчика #3 ............................................................................... 291
Задача Мадахи #22 .............................................................................. 293
Задача Мартина Гарднера.................................................................... 295
7

Проект Высокая степень искусства ................................................................. 298
Проект Числа Армстронга.................................................................................. 302
Словесные дистанции .......................................................................................... 310
Проект Алгоритм Левенштейна .........................................................................311
Проект Шестизначный перенос ........................................................................ 320
Проект Найдите число......................................................................................... 321
Проект Паразитические числа ......................................................................... 333
Проект Циклические числа ............................................................................... 337
Проект Супержесть ............................................................................................... 349

Литература ........................................................ 355

8

Олимпийские задачи

9

Проект Олимпиадная задача
Исходный код программы находится в файле Олимпиадная задача.pas.
Первая олимпиадная задача должна быть очень простой!
В своё время на городской олимпиаде по математике я решал такую задачу:
Подсчитайте, сколько раз пятёрка входит в представление чисел от 1 до
1000 в виде произведения простых чисел: 2, 3, 5, 7, 11,… (например, 24 = 2 * 2*
2 * 3; 25 = 5 * 5).
Простенькая программа поможет нам решить задачу:
##

// Олимпиадная задача

// счётчик пятерок:
var n5 := 0;
// проверяем все заданные числа:
for var i := 1 to 1000 do begin
var n := i;
var flg := true;
while (flg) do begin
// если число делится на 5,
// увеличиваем счетчик пятерок:
if (n mod 5 = 0) then begin
n := n div 5;
n5 += 1;
PrintLn($' Число = {i}
n5 = {n5}');
end
else flg := false;
end // while
end;
// for
WriteLn(' Число пятёрок =', n5);

Здесь вы легко найдёте цикл for, в котором перебираются все заданные
числа, и вложенный в него цикл while, который и подсчитывает их
10

делители. Если число нацело делится на 5, то счётчик увеличивается на 1,
иначе мы переходим к проверке следующего числа. Олимпиадный «подвох»
этой задачи заключается в том, что полученное после деления на 5 число
опять может быть кратно 5, то есть его снова нужно проверить. Если это
обстоятельство не учесть, то число пятёрок можно было бы подсчитать
мгновенно: 1000 : 5 = 200.
Таким образом, в первой тысяче чисел ровно 200 делятся на 5. Ещё 40 делятся на 25 (5*5), 8 – на 125 (5*5*5) и одно – на 625 (5*5*5*5)!
Компьютер справился с олимпиадной задачей!
Число пятёрок = 249

Проект Сумма чисел
Исходный код программы находится в файле Сумма чисел.pas.

Вторая задача – не олимпиадная, но она на простом примере показывает
суть рекурсивного решения многих, в том числе и олимпиадных задач.
Первоисточник – интерактивный учебник (а также его перевод на русский
язык) Problem Solving with Algorithms and Data Structures.

11

Суть рекурсии заключается в разбиении задачи на более мелкие подзадачи
– до тех пор, пока не останется такая подзадача, которая решается элементарно.
Так как все подзадачи (кроме, может быть, самой «мелкой») главной задачи
решаются однотипно, то достаточно одной функции, которая рекурсивно
вызывает сама себя с разными аргументами.
А теперь перейдём непосредственно к задаче, которая очень проста: подсчитать сумму элементов в списке. Понятно, что решение задачи не зависит от длины списка, поэтому в условии задачи список включает всего 5 однозначных чисел.
Поскольку мы заранее знаем, что в списке ровно 5 чисел, то можем использовать для их хранения обычный массив, но список типа List – более универсальная структура данных, поэтому может пригодиться вам при развитии этой задачи.
Итак, в главной программе мы создаём список и заполняем его числами:
begin
// сумма чисел:
var a := | 1, 3, 5, 7, 9 |.ToList;

В реальной программе мы легко нашли бы сумму элементов списка, просто
вызвав метод расширения Sum:
var sum := a.Sum;
writeln($' Сумма чисел = {sum}');

Но в задаче предполагается, что мы будем честно пересчитывать все элементы списка самостоятельно. Это легко сделать в цикле, однако условие
задачи запрещает использовать любые циклы, поэтому этот способ не
годится.

12

Но мы можем заменить любой цикл рекурсивными вызовами функции
SumRec:
// РЕКУРСИВНАЯ ФУНКЦИЯ
function SumRec(nums: List<integer>): integer;
begin
if (nums.Count = 1) then
result := nums.First
else
result := nums.First + SumRec(nums.Skip(1).ToList);
end;

При каждом её вызове к переменной result добавляется первый элемент в
списке, а затем снова вызывается эта же функция, но с новым списком, в котором отсутствует уже посчитанный первый элемент предыдущего списка.
Таким образом, каждый раз из списка удаляется его первый элемент, значит, список становится короче на 1 элемент с каждым вызовом функции.
В функции SumRec нетрудно усмотреть элементарную подзадачу: рекурсивные вызовы заканчиваются, когда в списке останется единственный
элемент. Сумма такого списка, естественно, равна самому элементу.
Рекурсивные вызовы завершаются, и функция начинает снимать со стека и
складывать в сумму все элементы исходного списка. Совершенно очевидно,
что так мы найдём сумму элементов любого списка:
begin
// сумма чисел:
var a := | 1, 3, 5, 7, 9 |.ToList;
var sum := a.Sum;
writeln($' Сумма чисел = {sum}');
sum := SumRec(a);
writeln($' Сумма чисел = {sum}');
writeln;
end.

13

Сумма чисел = 25
Сумма чисел = 25

Подобным же способом можно решать любые задачи, в которых используются циклы.

Проект Режем прямоугольники
Исходный код программы находится в файле Режем прямоугольники.pas.
Эта задача уже по-настоящему олимпиадная:
От заданного прямоугольника каждый раз отрезается квадрат максимальной площади (длины сторон фигур выражаются натуральными числами).
Найти число таких квадратов.
Её решение есть в книге Практикум программирования на Turbo Pascal.
Мы решим задачу несколько иначе, но отличия непринципиальные.
Сначала мы получаем от пользователя 2 числа – a и b – длины сторон исходного прямоугольника:
begin
Writeln(' Режем прямоугольники');
var (a, b) := ReadInteger2(' Введите длину сторон прямоугольника
(натуральные числа:');

И вызываем функцию Solve для подсчёта квадратов:
var n := Solve(a, b);
14

Println($' Число квадратов = {n}');
Writeln;
end.

В функции Solve цикл while считает отрезаемые квадраты в переменной
n:
// РЕШАЕМ ЗАДАЧУ
function Solve(a, b: integer): integer;
begin
var n: integer;
while (a * b > 0) do begin
if (a >= b) then begin
n += a div b;
a := a mod b;
end
else begin
n += b div a;
b := b mod a;
end;
end;
Result := n;
end;

Здесь нужно рассмотреть 2 случая:
1. Сторона a не короче стороны b.
2. Сторона a короче стороны b.
В первом случае мы отрезаем от прямоугольника a div b квадратов с длиной
стороны b. В результате длинная сторона a укорачивается до a mod b. Когда
одна из сторон станет равной нулю, все квадраты будут отрезаны, и решение закончится.
Второй случай аналогичен первому, только нужно поменять местами стороны а и b.

15

Цикл while (книжное решение) мы легко заменим вызовом функции
SumRec:
n := SumRec(a, b);
Println($' Число квадратов = {n}');
Writeln;
end.

Рекурсивную функцию SumRec легко написать по аналогии с циклом while:
// РЕШАЕМ ЗАДАЧУ РЕКУРСИВНО
function SumRec(a, b: integer): integer;
begin
if (a * b > 0) then begin
if (a >= b) then
result := a div b + SumRec(a mod b, b)
else
result := b div a + SumRec(a, b mod a);
end;
end;

Как вы видите, рекурсивная функция получилась очень простая и даже короче, чем цикл while.
При длине сторон прямоугольника 135 и 40 единиц (книжные значения) от
него можно отрезать 8 квадратов:
Режем прямоугольники
Введите длину сторон прямоугольника (натуральные числа): 135 40
Число квадратов = 8
Число квадратов = 8

Чтобы лучше понять действие алгоритма, прибегнем, как обычно, к наглядному рисованию.
16

Размеры прямоугольника уменьшим в 5 раз, чтобы на рисунке можно было
разглядеть клеточки. На самом решении пропорциональное изменение размеров, конечно, никак не отразится.
Тогда вначале мы имеем прямоугольник со сторонами 27 и 8 клеток:

Сторона отрезаемого квадрата всегда равна меньшей стороне прямоугольника. В нашем случае – 8. Начинаем отрезать от прямоугольника такие
квадраты, пока это возможно.
Всего мы сможем отрезать a div b таких квадратов, если a – большая сторона прямоугольника. От нашего прямоугольника мы отрежем 3 квадрата
8 х 8 клеток:

И от него останется прямоугольный кусок 8 х 3 клетки.
Запоминаем: меньшая сторона после отрезания становится большей, и
наоборот.

17

От прямоугольника 8 х 3 клетки мы сможем отрезать 2 квадрата 3 х 3
клетки:

Длина сторон квадрата, как мы уже выяснили, равна длине меньшей стороны прямоугольника.
Теперь остался прямоугольник 3 х 2 клетки, от которого можно отрезать 1
квадрат 2 х 2 клетки:
И от последнего прямоугольника 2 х 1 клетку отрезаем 2 единичных квадрата:

18

На этом разрезании от исходного прямоугольника ничего не осталось, а
число квадратов легко подсчитать – их ровно 8 штук.
Пользуясь нашим визуальным алгоритмом, мы можем написать новую версию рекурсивной функции:
function SumRec2(a, b: integer): integer;
begin
if (b > 0) then
result := a div b + SumRec2(b, a mod b)
end;

В главной программе мы вызываем функцию SumRec2 и в ответ получаем
ответ:
n := SumRec2(a, b);
Println($' Число квадратов = {n}');
Writeln;

Проект Двузначные числа
Исходный код программы находится в файле Двузначные числа.pas.

Эта задача также из книги Практикум программирования на Turbo Pascal.
Задана последовательность двузначных натуральных чисел. Длина последовательности неизвестна, а признаком её конца служит 0.
Напечатать члены последовательности в неубывающем порядке.

19

Поскольку длина последовательности заранее неизвестна, то для её хранения разумно использовать список. В Турбопаскале такая структура данных
отсутствует, поэтому элементы нужно хранить в массиве, длину которого
следует знать заранее. Возникает противоречие, для разрешения которого
нужна догадка!
Действительно, последовательность может быть очень длинной, но все её
элементы – это двузначные числа от 10 до 99. А это значит, что в массиве
можно хранить не сами числа, а их кратность в заданной последовательности (числа в последовательности могут повторяться!). Тогда для решения
задачи достаточно целочисленного массива с индексами 10..99.
Чтобы не решать уже решённую задачу, мы вспомним, что у нас имеется
PascalABC.NET, а в нём – класс List, в экземплярах которого котором удобно
хранить числовую последовательность любой длины.
Мы не будем вводить множество чисел с клавиатуры, как это делается в
книге, а имитируем этот процесс. При этом мы предполагаем, что «вводимые» числа не обязательно двузначные, поэтому добавляем в список
только те из них, которые удовлетворяют условию задачи:
// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
// создаём список для хранения последовательности:
var lst := new List<integer>();
// заполняем его числами:
var max := 200;
var nelem := Random(200, 1000);
for var i := 0 to nelem do begin
var num := Random(max + 1);
if num.InRange(10, 99) then
lst.Add(num);
end;
. . .

begin
Writeln(' Двузначные числа');
Writeln;
Solve();
20

end.

А всё решение задачи укладывается в две строки:
// сортируем список:
lst.Sort();
lst.Println;
Writeln;
end;

Или даже в одну:
lst.OrderBy(n -> n).Println;

Если вы незнакомы с LINQ, то можете распечатать список с помощью цикла
foreach:
foreach var i in lst do
write(i: 3);

Наше решение хоть и отличается от книжного, но тоже красивое!
Двузначные числа
10 10 11 11 11 12 12 12 13 13 13 13 13 13 15 15 15 15 15 16 16 16 16 17
17 18 18 18 18 19 20 21 22 22 22 23 24 24 24 25 25 25 26 26 26 27 27 28
28 28 29 29 29 29 30 30 31 31 32 32 32 32 33 33 33 33 33 34 34 37 37 38
38 39 40 41 41 41 41 41 41 41 42 42 42 42 42 43 43 44 44 45 46 47 47 47
47 47 47 48 48 49 49 49 49 49 50 51 51 51 51 52 52 52 52 52 53 53 53 54
54 54 55 55 55 56 57 57 57 57 58 58 59 59 59 59 60 61 61 61 62 63 63 63
63 63 63 64 64 64 65 65 65 66 66 66 66 66 67 67 68 69 69 70 71 72 72 72
72 72 73 73 73 75 75 75 76 76 76 76 76 76 76 77 77 77 77 77 79 79 79 79
80 80 81 81 81 82 82 82 82 82 82 83 83 84 84 84 84 84 85 85 85 85 86 86
87 88 88 88 89 89 90 90 90 90 91 91 91 92 92 92 93 93 94 95 95 95 96 96
96 97 97 97 97 97 97 98 98 99 99 99
21

Проект Задача Клайва Синклера
Исходный код программы находится в файле Задача Клайва Синклера.pas.
Эта задача почти олимпиадная. Её придумал сэр Клайв Синклер (тот самый
Синклер, который сделал компьютер ZX Spectrum, в своё время очень популярный в Советском Союзе).

А задача такая: подсчитать число разных прямоугольников в сетке 9 х
9 клеток. Поскольку квадрат - это тоже прямоугольник, то самый первый
квадратик уже можно посчитать. Для уменьшения расхода бумаги мы
22

дальше будем рассматривать сетку размером 3 х 3 клетки, а затем обобщим
задачу.

Если мы будем расширять первый прямоугольник по ширине и высоте, то
всего получим 9 прямоугольников.

23

Если мы переместим угловой квадрат на 1 и 2 строки ниже, а затем выполним те же «мероприятия», то насчитаем ещё 9 прямоугольников.

Точно так же мы подсчитаем прямоугольники для случая, когда единичный
квадрат находится в первой и во второй колонках сетки.

24

Итого для сетки 3 х 3 мы насчитали 36 разных прямоугольников. Давайте
разберёмся, как получилась эта сумма:
1. Мы передвигаем единичный квадрат от нулевой колонки до колонки
3-1 = 2 (нумерация начинается с нуля). На рисунках хорошо видно, что по
ширине всегда получается 3-col прямоугольников.
То есть:
для col = 0 → 3
для col = 1 → 2
для col = 2 → 1
2. Мы передвигаем единичный квадрат на всех колонках от нулевой
строки и до строки 3-1=2. Каждый раз по высоте получается n-row прямоугольников.
То есть:
для row = 0 → 3
для row = 1 → 2
25

для row = 2 → 1
3. Перемножаем число прямоугольников по ширине на число прямоугольников по высоте для всех значений col и row и добавляем к общей
сумме. В итоге мы получаем число всех прямоугольников в сетке.
И нам нужно только вместо размерности сетки 3 поставить число n – и задача решена!
Итак, в главной программе пользователь вводит число – размерность сетки.
Она всегда квадратная, поэтому достаточно одного числа.
Вы легко обобщите задачу для прямоугольных сеток, но тогда пользователь должен вводить два числа.

Подсчёт прямоугольников мы проведём в функции CalcRects, а главная
программа напечатает их число:
begin
Writeln(' Задача Клайва Синклера');
Writeln;
// бесконечный цикл ввода данных // пока пользователь не закроет программу:
while (true) do begin
var number := ReadInteger(' Введите размерность квадрата (1..) >');
// находим число прямоугольников:
var nRects := CalcRects(number);
// печатаем ответ:
Writeln($' Число прямоугольников = {nRects}');
Writeln;
end;
end.

Функцию CalcRects кодируем по нашему алгоритму:
26

•

Число прямоугольников храним в переменной res.

•

Изменяем номер колонки с единичным квадратиком от 0 до n-1.

•

Изменяем номер строки с единичным квадратиком от 0 до n-1.

•

Подсчитываем число новых прямоугольников для текущего значения

col и row = 0..n-1.
•

Добавляем новые прямоугольники к общей сумме res:

// ПРОГРАММА ДЛЯ РЕШЕНИЯ ЗАДАЧИ
// КЛАЙВА СИНКЛЕРА
// ПОДСЧИТЫАЕМ ПРЯМОУГОЛЬНИКИ
function CalcRects(n: integer): integer;
begin
// число прямоугольников:
var res := 0;
// по ширине сетки:
for var col := 0 to n - 1 do begin
// число прямоугольников по ширине:
var nCol := n - col;
// по высоте сетки:
for var row := 0 to n - 1 do begin
// число прямоугольников по высоте:
var nRow := n - row;
// добавляем:
res += nCol * nRow;
end;
end;
Result := res;
end;

Запускаем программу и находим число прямоугольников в любых квадратных сетках.
Задача Клайва Синклера
Введите размерность квадрата (1..) > 1
27

Число прямоугольников = 1
Введите размерность квадрата (1..) > 2
Число прямоугольников = 9
Введите размерность квадрата (1..) > 3
Число прямоугольников = 36
Введите размерность квадрата (1..) > 4
Число прямоугольников = 100
Введите размерность квадрата (1..) > 5
Число прямоугольников = 225
Введите размерность квадрата (1..) > 6
Число прямоугольников = 441
Введите размерность квадрата (1..) > 7
Число прямоугольников = 784
Введите размерность квадрата (1..) > 8
Число прямоугольников = 1296
Введите размерность квадрата (1..) > 9
Число прямоугольников = 2025
Введите размерность квадрата (1..) > 10
Число прямоугольников = 3025

Для задачи Синклера ответ такой: 2025 прямоугольников.
На этом можно было бы и закончить решение задачи, но трудно не обратить
внимание на то, что число прямоугольников всегда (по крайней мере, для
наших значений сетки) равняется квадрату какого-либо числа:
1 – 12
9 – 32
36 – 62
100 – 102
225 – 152
441 – 212
28

784 – 282
1296 – 362
2025 – 452
3025 - 552
На сайте oeis.org эта же последовательность чисел скрывается под кодом
A000537:
0, 1, 9, 36, 100, 225, 441, 784, 1296, 2025, 3025, 4356, 6084,
8281, 11025, 14400, 18496, 23409, 29241, 36100, 44100, 53361,
64009, 76176, 90000, 105625, 123201, 142884, 164836, 189225,
216225, 246016, 278784, 314721, 354025, 396900, 443556, 494209,
549081
И она не имеет никакого отношения к нашей задаче, а показывает сумму n
первых кубов:
03 = 0
03+13 = 1
03+13+23=9
03+13+23+33=36
03+13+23+33+43=100
. . .
С другой стороны, последовательность 1, 3, 6, 10,
15, 21, 28, 36, 45, 55,… представляет собой треугольные числа.
Треугольные числа – это разновидность фигурных чисел, о которых можно прочитать, например, в книге Мартина Гарднера Путешествие во
времени.

29

На рисунке⬆ видно, что треугольные числа можно найти как сумму членов
арифметической прогрессии:
1 + 2 + 3 + 4 + 5 + … = n(n+1)/2,
где n – номер треугольного числа.
Решением задачи Клайва Синклера служат квадраты этих чисел, поэтому
число прямоугольников в сетке размерами n x n клеток можно сразу же вычислить по формуле:
(n(n+1)/2)2
Подставляем n = 9 и получаем ответ:
30

(9х10/2)2 = 452 = 2025
Теперь сведём наши числовые наблюдения воедино и получим забавную
формулу, связывающую кубы и квадраты чисел (а также треугольные
числа):
03 = 0
03+13 = (0 +1)2 = 1
03+13+23 = (0 +1 + 2)2= 9
03+13+23+33 =(0 +1 + 2 + 3)2 = 36
03+13+23+33+43 = (0 +1 + 2 + 3 + 4)2 = 100
. . .
Увы, не мы первые обнаружили это удивительное свойство степеней. Древнегреческий математик Никомах доказал теорему (Nicomachus's Theorem),
согласно которой куб любого натурального числа можно представить в
виде суммы последовательных нечётных чисел:
13 = 1
23 = 3 + 5
33 = 7 +9 + 11
43 = 13 + 15 + 17 + 19
. . .
Из этой теоремы и вытекает то самое соотношение кубов и квадратов, которое мы вывели.
Вот так, странным образом задача Клайва Синклера оказалась связана с
древней теоремой Никомаха!

Project Euler
В Интернете есть интересный сайт Project Euler, который вы найдёте по
адресу projecteuler.net. Он посвящён компьютерному решению
31

математических проблем, которые можно охарактеризовать как олимпиадные задачи по программированию. Проект начался в 2001 году и
сейчас насчитывает почти тысячу задач разного уровня сложности. Я думаю, что некоторые из них по силам вам уже сейчас. Выбирайте из предложенных задач те, с которыми справились многие участники проекта. К сожалению, ни ответов, ни указаний по решению задач на сайте нет, так что
вам придётся полагаться только на свои силы.

Начальная страница сайта Проект Эйлер
Но зато ведётся подсчёт участников, справившихся с каждой задачей. Все
задания представлены на английском языке, поэтому могут вызвать у вас
затруднения, но на сайте euler.jakumo.org вы найдёте их перевод на русский
язык.
32

Русская версия сайта

33

Проект Эйлер001
Исходный код программы находится в файле Эйлер001.pas.

Самая первая задача называется Multiples of 3 or 5. Она очень простая. Более миллиона участников этого математического ристалища справились с
ней на раз-два.
Задача номер 1 (Problem 1) называется Multiples of 3 and 5:
If we list all the natural numbers below 10 that are multiples of 3 or 5, we get 3, 5, 6
and 9. The sum of these multiples is 23.
Find the sum of all the multiples of 3 or 5 below 1000.
Найдите сумму всех натуральных чисел, которые:
• меньше 1000
• делятся без остатка на 3 или на 5
Поскольку нужно проверить всего 999 чисел, то для решения задачи можно
воспользоваться методом грубой силы и просто перебрать все числа в любом цикле.
procedure Solve();
begin
var sum := 0;
for var i := 1 to 999 do begin
if (i mod 3 = 0) or (i mod 5 = 0) then
sum += i;
end;
Println($' Сумма равна: {sum}');
WriteLn;
end;

34

begin
Writeln(' Project Euler. Problem 1');
WriteLn;
Solve();
end.

Если подумать, то задачу можно решить и без перебора, причём для любого
диапазона чисел.
Все числа, кратные трём, образуют арифметическую последовательность: 3 6 9 12 15 18 . . .
Аналогично – для чисел, кратных пяти:
5 10 15 20 25 30 . . .
Сумму последовательности натуральных чисел легко найти по формуле:
sum(N) = (N+1)N / 2,
где N – число членов в последовательности.
Если мы знаем максимальное число, которого не превышают члены последовательности, то число членов можно вычислить так:
Nk = [max / k],
то есть мы должны найти целую часть дроби.
k - это число, кратному которому мы ищем числа в последовательности.
Теперь мы сможем без всякого перебора, сразу найти сумму заданных чисел, кратных трём или пяти. Но мы дважды посчитаем числа, которые одновременно делятся на 3 и на 5. Чтобы получить верное решение, необходимо
из полученной суммы вычесть сумму чисел, кратных 3 и 5 одновременно.
Пускаемся на хитрость и в функции GetSum подсчитываем сумму членов
арифметической последовательности:
function GetSum(max, k: integer): integer;
35

begin
var N := max div k;
var res := k*(N + 1) * N div 2;
GetSum := res;
end;

В процедуре Solve2 находим сумму чисел, которые делятся нацело на 3 и на
5, но тогда нужно вычесть сумму чисел, которые одновременно делятся на
3 и на 5, то есть на 15:
procedure Solve2();
begin
var sum := GetSum(999, 3) + GetSum(999, 5) - GetSum(999, 3*5);
Println($' Сумма равна: {sum}');
WriteLn;
end;

Смелее всего и неплохо задача решается в функциональном стиле.
Функция Range генерирует все числа в заданном диапазоне:
procedure Solve3();
begin
var sum := Range(1,999)

Метод расширения Where пропускает через себя дальше только те числа,
которые не дерзят условию задачи. Внутрь этого метода мы без заботы и
труда впихиваем нехитро-бесхитростное условие задачи. Чисто математически, если число кратно трём или пяти, то остаток от деления на эти числа
должен быть равен нулю:
.Where(n -> (n mod 3 = 0) or (n mod 5 = 0))

Метод расширения Sum находит сумму этих чисел:
36

.Sum;
Println($' Сумма равна: {sum}');
WriteLn;
end;

Задача решена напрочь и упала к нашим ступням навзничь! Печатаем победные реляции на экране – для себя и для вокруг себя, если таковые
найдутся и подвернутся под горячую руку. Запускаем нашу программу со
свойственными нам решимостью и решительностью.
Нетрудно догадаться, что программа с лёгкостью в мыслях необыкновенной тут же выдаст нам ответ на эйлеровскую задачу.
Project Euler. Problem 1
Сумма равна: 233168
Сумма равна: 233168
Сумма равна: 233168

Мы использовали и дальше будем использовать повсеместно методы расширения для последовательностей. Это быстро, удобно и спонтанно!
Мы уже слегка обильно приложились к функциональному программированию, которое зиждется на методах расширения. Для решения первой эйлеровской задачи мы использовали методы расширения Where и Sum, которые укорачивают, утончают и проясняют код.
Напротив, в мире людей-программистов есть и будут есть методы разжирения, которые тлетворно и пагубно влияют на экстерьер человеческого
программиста в любую ширь.
Так выпьем же и плотно закусим губу за искусственный интеллект!
37

Проект Эйлер002
Исходный код программы находится в файле Эйлер002.pas.

Задача номер 2 (Problem 2) называется Even Fibonacci numbers:
Each new term in the Fibonacci sequence is generated by adding the previous two
terms. By starting with 1 and 2, the first 10 terms will be:
1, 2, 3, 5, 8, 13, 21, 34, 55, 89, …
By considering the terms in the Fibonacci sequence whose values do not exceed
four million, find the sum of the even-valued terms.
38

Четные числа Фибоначчи
Каждый следующий элемент ряда Фибоначчи получается при сложении
двух предыдущих. Начиная с 1 и 2, первые 10 элементов будут:
1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ...
Найдите сумму всех чётных элементов ряда Фибоначчи, которые не
превышают четыре миллиона.
Я надеюсь, что вы знаете или хотя бы наслышаны о числах Фибоначчи, поэтому не будем попусту терять время на душещипательную историю про
его кроликов.
Более того, уже в условии задачи хорошо, верно и правильно объясняется
процесс рождения этих кроличьих чисел.
Также условие задачи должно подтолкнуть нас к свежей и здоровой мысли,
что для решения задачи и для нашего светлого математического будущего
нам нужен генератор чисел Фибоначчи.
Учитываем, что эту задачу решили более восьмисот тысяч участников проекта, то есть само решение не настолько сложное, чтобы спасовать или забуксовать на математических колдобинах и выбоинах.
Для начала, входа в решение задачи и последующего разгона скорости пишем несложный генератор чисел Фибоначчи для нашей математической
библиотеки. Тут следует отметиться ремаркой, что ряд чисел Фибоначчи
начинается либо с нуля и единицы, либо с единицы и двойки.
В модуле FibonacciGenerator реализованы оба варианта. Функция Classic
генерирует числа, начиная с нуля, а функция Alternative – с единицы:
/// Стандартная последовательность (0, 1, 1, 2, 3...)
static function Classic: sequence of int64;
/// Альтернативная последовательность (1, 2, 3, 5, 8...)
static function Alternative: sequence of int64;

Подключаем наши математические модули:
39

uses FibonacciGenerator, MathExtensions;

40

В процедуре Solve запускаем генератор чисел Фибоначчи, который работает на полную катушку, беспечно и бесконечно:
procedure Solve();
begin
var res := Fibonacci.Alternative

Метод расширения TakeWhile следит, чтобы очередное число Фибоначчи
не превысило четырёх миллионов. В случае чего он прекратит дальнейшее
производство кроликов в целях защиты Австралии от переполнения:
.TakeWhile(n -> n <= 4_000_000)

Метод расширения Where пропускает в метод расширения Select только
чётные числа, как того и требует от нас условие задачи:
.Where(n -> n.IsEven)
.Select(n -> n)

Метод расширения Sum прозрачно намекает нам до полного понимания,
что он суммирует все числа, удовлетворяющие условию задачи, и отсылает
окончательный диагноз в переменную res:
.Sum();

Для забавы и потехи над собой и задачей печатаем ответ на экране, который определённо верный:
// печатаем ответ:
Println($' Сумма равна: {res}');
WriteLn;
end;
41

begin
Writeln(' Project Euler. Problem 2');
WriteLn;
Solve();
end.

Запускаем нашу программу прямо в вольер с чётными кроликами Фибоначчи, которым как бы счёту нет, но это не так!
Кроличьих чисел оказалось в сумме больше четырёх миллионов, что для
кроликов, безусловно, не предел:
Project Euler. Problem 2
Сумма равна: 4613732

Желающие потешить себя без посторонней помощи могут решить задачу,
например, так:
procedure Solve2();
begin
var f := 0;
var f1 := 1;
var f2 := 1;
var sum := 0;
while (f <= 4000000) do begin
f := f1 + f2;
f1 := f2;
f2 := f;
if f1.IsEven then
sum += f1;
end;
// печатаем ответ:
Println($' Сумма равна: {sum}');
WriteLn;
end;

42

Добиваем олимпиадных кроликов лемурами!
Все знают или делают из себя такой вид, что у лемуров долгопятов по ночам
чешутся долгие пятки, поэтому они пучат глаза и охотятся ночью за насекомыми и прочей ночной нечистью.
Но не все или вообще никто не знает, что есть и другие лемуры, которые
долго спят и днём, и ночью, а питаются только своими снами, а потом и с
нами. Они легко приручаются, привыкают к городской жизни, уюту и комфорту. И зовут их – лемуры-долгоспяты.

Проект Эйлер003
Исходный код программы находится в файле Эйлер003.pas.

Задача номер 3 (Problem 3) называется Largest prime factor. Она была
опубликована 2 ноября 2001 года.
43

The prime factors of 13195 are 5, 7, 13 and 29.
What is the largest prime factor of the number 600851475143?
Наибольший простой делитель
Найдите самый большой простой делитель числа 600851475143.
У нас есть число типа int64 – это важно! Метод расширения GetFactors возвращает список всех делителей этого числа:
uses MathExtensions;

procedure Solve;
begin
var num: int64 := 600851475143;
var res := num.GetFactors

Но нам нужны только простые делители, которые отбирает метод where:
.Where(n -> n.IsPrime);

Распечатываем все простые делители заданного числа:
foreach var n in res do
Writeln($' {n}');

Самый большой делитель – последний в списке:
WriteLn($' Самый большой простой делитель = {res.Last}');
WriteLn;
end;

44

После добавления метода расширения GetPrimeFactors в модуль
MathExtensions задача решается и того проще:
uses MathExtensions;

procedure Solve2;
begin
var res := 600851475143.GetPrimeFactors;
WriteLn($' Самый большой простой делитель = {res.Last}');
WriteLn;
end;

begin
Writeln(' Project Euler. Problem 3');
WriteLn;
Solve();
Solve2();
end.

Запускаем программу и через мгновение получаем список всех простых делителей заданного числа. Ответ на задачу – последний, самый большой из
них:
Project Euler. Problem 3
71
839
1471
6857
Самый большой простой делитель = 6857
Самый большой простой делитель = 6857

45

Проект Эйлер004
Исходный код программы находится в файле Эйлер004.pas.

Задачи с палиндромами очень часто предлагаются на различных олимпиадах по программированию. Вот и Проект Эйлер также не обделил своим
вниманием числовые палиндромы.
Задача номер 4 (Problem 4) называется Largest palindrome product. Она
была опубликована 16 ноября 2001 года.
A palindromic number reads the same both ways. The largest palindrome made
from the product of two 2-digit numbers is 9009 = 91 99.
Find the largest palindrome made from the product of two 3-digit numbers
Наибольшее произведение-палиндром
Найдите наибольший палиндром среди произведений двух трёхзначных чисел.
Палиндромами называют слова, числа, предложения, которые одинаково читаются и слева направо, и справа налево.

Обозначим первое трёхзначное число буквой i, а второе - буквой j. Чтобы не
находить каждый палиндром дважды, будем считать, что j >= i. Тогда значениями переменной i могут быть числа от 100 (наименьшее трёхзначное
число) до 999 (наибольшее трёхзначное число). Переменная j принимает
значения от i до 999. Во вложенных циклах мы находим произведения всех
трёхзначных чисел, выделяем из них палиндромы и запоминаем самый
большой из них.
В главной программе вызываем процедуру Solve, которая и решает задачу:
46

begin
Writeln(' Project Euler. Problem 4');
WriteLn;
Solve();
end.

Самое сложное действие в процедуре Solve – это определение «палиндромности» очередного произведения:
// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin
var nVar := 0;
var max := 0;
var maxi := 0;
var maxj := 0;
for var i :=100 to 999 do
for var j := i to 999 do begin
var mul := i * j;
var smul := mul.ToString();
if IsPalindrome(smul) then begin
println($' {i} * {j} = {smul}');
if (mul > max) then begin
max := mul;
maxi := i;
maxj := j;
end;
nVar += 1;
end;
end;
WriteLn($' Всего палиндромов: {nVar}');
WriteLn;
WriteLn($' Наибольший палиндром: {maxi} * {maxj} = {max}');
WriteLn;
end;

Наиболее простой способ для этого – преобразовать число в строку методом
ToString, а затем проверить эту строку:
47

uses MathExtensions;
function IsPalindrome(w : string): bool;
begin
var flg := true;
var len := w.Length;
// слово-палиндром?
for var i := 1 to len div 2 do begin
var ch1 := w[len-i+1];
var ch2 := w[i];
// не палиндром:
if (ch1 <> ch2) then
exit(false);
end;
Result := flg;
end;

Вот и вся задача!
Project Euler. Problem 4
101
101
101
101
101
101
101
101

*
*
*
*
*
*
*
*

897 *
902 *
902 *
913 *
916 *
924 *
924 *
Всего

101
111
121
131
141
151
161
171

=
=
=
=
=
=
=
=

10201
11211
12221
13231
14241
15251
16261
17271

924 = 828828
909 = 819918
914 = 824428
993 = 906609
968 = 886688
932 = 861168
962 = 888888
палиндромов: 1239
48

Наибольший палиндром: 913 * 993 = 906609

Цифровой вариант решения
Обычно на олимпиадах и конкурсах следует использовать только такие возможности, которые имеются практически во всех языках программирования. За метод ToString мы поручиться не можем, поэтому нам нужно либо
написать такой метод для нашего проекта, либо решить задачу вообще без
строк, что, безусловно, правильнее, коль скоро мы имеем дело с числами.
Главная функция в нашей программе - это IsPalindrome, которая сравнивает симметричные относительно середины слова w символы. При этом
символы извлекаются из строки, как из массива. Из числа типа integer так
просто нельзя извлечь нужную цифру. Это значит, что нам нужно превратить заданное число в массив цифр digits. Тогда функцию IsPalindrome
легко переделать:
function IsPalindrome(digits: array of int): bool;
begin
var flg := true;
var len := digits.Length;
// число-палиндром?
for var i := 0 to len div 2 - 1 do begin
var d1 := digits[len - i - 1];
var d2 := digits[i];
// не палиндром:
if (d1 <> d2) then
exit(false);
end;
Result := flg;
end;

В функции GetDigits мы последовательно выделяем из числа его цифры,
начиная с разряда единиц, то есть двигаемся справа налево. Каждую цифру
помещаем в массив цифр digits:
49

function GetDigits(num: int): array of int;
begin
var len := GetLenNum(num);
var digits := new int[len];
var i := 0;
while (num > 0) do begin
digits[i] := num mod 10;
num := num div 10;
i += 1;
end;
Result := digits;
end;

Поскольку размер массива нужно знать ещё до его заполнения, то мы
должны решить и эту задачу. Самый простой способ узнать длину числа –
это найти его десятичный логарифм, взять целую часть и добавить единицу:
function GetLenNum(num: int): int;
begin
num := Abs(num);
var len := Trunc(Log10(num)) + 1;
Result := len;
end;

Проверим! Для однозначных чисел 1..9 логарифм равен 0..0.954. После отбрасывания дробной части останется 0. Добавляем единицу и получаем
длину однозначных чисел – 1.
Для двузначных чисел 10..99 логарифм изменяется в пределах от 1 до
1.995. После тех же манипуляций получаем длину, равную двум.
Очевидно, что и для многозначных чисел метод GetLenNum вернёт правильную длину.
Теперь в методе GetDigits мы можем сразу узнать, сколько цифр содержится в числе, и создать массив соответствующего размера:
50

var len := GetLenNum(num);
var digits := new int[len];

Заполнение массива происходит так. Если число равно нулю, то массив содержит единственный элемент со значением 0. Цикл while не выполнится
ни разу.
Во всех остальных случаях (мы не рассматриваем отрицательные числа, поскольку у нас их быть не может) выполняется тело цикла:
var i := 0;
while (num > 0) do begin
digits[i] := num mod 10;
num := num div 10;
i += 1;
end;

Последнюю цифру числа легко выделить, если найти остаток от деления
этого числа на 10. Например, для однозначных чисел это будет само число.
Для многозначных – его последняя цифра:
102 → 2
999 → 9
Поместив цифру в массив digits под индексом i, мы переходим к следующему элементу в массиве. И нам нужно избавиться от последней цифры в
числе, которую мы уже определили в массив. Для этого мы просто делим
число на 10. Так как число num имеет тип integer, то останется только целая часть частного:
102 → 10
999 → 99
Теперь цикл while добавит в массив последнюю цифру частного:
10 → 0
99 → 9
И укоротит число ещё на одну – последнюю – цифру:
51

10 → 1
99 → 9
В следующей итерации в массив попадут оставшиеся цифры:
1 → 1
9 → 9
А при делении однозначных чисел переменная num обнулится:
1 div 10 → 0
9 div 10 → 0
Условие в цикле while не выполнится, и он завершится. В массиве digits мы
имеем все цифры заданного числа:
102 → 1 0 2
999 → 9 9 9
2 1 0  индексы
Исправляем в процедуре Solve несколько строчек:
// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin
var nVar := 0;
var max := 0;
var maxi := 0;
var maxj := 0;
for var i :=100 to 999 do
for var j := i to 999 do begin
var mul := i * j;
var digits := GetDigits(mul);
//var smul := mul.ToString();
//if IsPalindrome(smul) then begin
if (IsPalindrome(digits)) then begin
println($' {i} * {j} = {mul}');
if (mul > max) then begin
max := mul;
52

maxi := i;
maxj := j;
end;
nVar += 1;
end;
end;
WriteLn($' Всего палиндромов: {nVar}');
WriteLn;
WriteLn($' Наибольший палиндром: {maxi} * {maxj} = {max}');
WriteLn;
end;

Проверка показывает, что новый вариант программы работает безупречно.
В модуле MathExtensions уже есть метод расширения IsPalindrome для целых чисел, поэтому мы можем обойтись без дополнительных функций:
// РЕШАЕМ ЗАДАЧУ
procedure Solve2;
begin
var nVar := 0;
var max := 0;
var maxi := 0;
var maxj := 0;
for var i :=100 to 999 do
for var j := i to 999 do begin
var mul := i * j;
if mul.IsPalindrome then begin
println($' {i} * {j} = {mul}');
if (mul > max) then begin
max := mul;
maxi := i;
maxj := j;
end;
nVar += 1;
end;
end;
WriteLn($' Всего палиндромов: {nVar}');
WriteLn;
WriteLn($' Наибольший палиндром: {maxi} * {maxj} = {max}');
WriteLn;
end;
53

Проект Эйлер005
Исходный код программы находится в файле Эйлер005.pas.

Пятая задача просто проверяет, владеете ли вы арифметической операцией
деления по модулю:
Задача номер 5 (Problem 5) называется Largest palindrome product. Она
была опубликована 14 декабря 2001 года.
2520 is the smallest number that can be divided by each of the numbers from 1 to
10 without any remainder.
What is the smallest positive number that is evenly divisible by all of the numbers
from 1 to 20?
Наименьшее кратное
2520 - самое маленькое число, которое делится без остатка на все числа от
1 до 10.
Какое самое маленькое число делится нацело на все числа от 1 до 20?
Легко заметить, что число -2520 меньше числа 2520 и тоже делится на все
числа от 1 до 10, поэтому искать ответ нужно только среди натуральных
чисел.
Можно предположить, что число будет немаленькое, но вполне укладывающееся в диапазон чисел типа integer. Это значит, что задачу вполне разумно решать методом грубой силы, то есть перебрать все натуральные
числа в бесконечном цикле while и проверить их на делимость. Если очередное число не делится нацело на какое-либо число из диапазона 1..20
(хотя на единицу делятся все числа, так что это требование избыточно), то
мы переходим к следующему кандидату на минимальное число min. Как
только мы найдём число, так сразу напечатаем ответ в Окне вывода.
uses MathExtensions;
54

// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin
// наименьшее натуральное число,
// удовлетворяющее условию задачи:
var min := 0;
while True do begin
min += 1;
var flg := true;
for var i := 1 to 20 do
if (min mod i <> 0) then begin
flg := false;
break;
end;
if (flg) then begin
WriteLn($' Минимальное число = {min}');
WriteLn;
break;
end;
end;
end;

begin
Writeln(' Project Euler. Problem 5');
WriteLn;
Solve();
end.

На полный перебор всех чисел потребовалось несколько секунд, и это гораздо меньше, чем мы затратили бы на оптимизацию алгоритма.
Project Euler. Problem 5
Минимальное число = 232792560

Можно сократить перебор, если исключить некоторые делители, которые
заведомо удовлетворяют условию задачи, если искомое число делится на
55

оставшиеся числа из ряда 1..20. Например, достаточно проверять такие делители:
procedure Solve2();
begin
// наименьшее натуральное число,
// удовлетворяющее условию задачи:
var min := 1;
// делители:
var del := | 11, 13, 14, 16, 17, 18, 19, 20 |;
while True do begin
var flg := true;

В данном случае для них нужно завести массив и проверять числа в цикле
foreach:
foreach var i in del do begin
if (min mod i <> 0) then begin
flg := false;
break;
end;
end;
if (flg) then begin
WriteLn($' Минимальное число = {min}');
WriteLn;
break;
end;
min += 1;
end;
end;

Поскольку это нужно и есть смысл, то обогащаем модуль MathExtensions
новыми полезностями:
/// НАИБОЛЬШИЙ ОБЩИЙ ДЕЛИТЕЛЬ ДВУХ ЧИСЕЛ
function GCD(a,b: int64) : int64;
begin
56

var (x, y) := (a, b);
while y <> 0 do (x, y) := (y, x mod y);
Result := x
end;

/// НАИМЕНЬШЕЕ ОБЩЕЕ КРАТНОЕ ДВУХ ЧИСЕЛ
function LCM(a, b: int64): int64;
begin
if (a = 0) or (b = 0) then
Result := 0
else
Result := Abs(a div GCD(a, b) * b);
end;

/// НАИМЕНЬШЕЕ ОБЩЕЕ КРАТНОЕ МАССИВА ЧИСЕЛ
function LCMArray(numbers: array of integer): int64;
begin
if numbers.Length = 0 then
raise new System.ArgumentException('Массив не может быть пустым');
Result := numbers[0];
for var i := 1 to numbers.Length - 1 do
Result := LCM(Result, numbers[i]);
end;

Теперь задача решается быстро, изящно и красиво:
procedure Solve3();
begin
// делители:
var del := | 11, 13, 14, 16, 17, 18, 19, 20 |;
// минимальное число:
var min := LCMArray(del);
WriteLn($' Минимальное число = {min}');
end;

57

Проект Эйлер006
Исходный код программы находится в файле Эйлер006.pas.

Шестая задача проверяет знания цикла for:
Задача номер 6 (Problem 6) называется Sum square difference. Она была
опубликована 21 декабря 2001 года.
The sum of the squares of the first ten natural numbers is,
12 + 22 + ... + 102 = 385
The square of the sum of the first ten natural numbers is,
(1 + 2 + ... + 10)2 = 552 = 3025
Hence the difference between the sum of the squares of the first ten natural numbers
and the square of the sum is 3025 − 385 = 2640.
Find the difference between the sum of the squares of the first one hundred natural
numbers and the square of the sum.
Разность между суммой квадратов и квадратом суммы
Сумма квадратов первых десяти натуральных чисел равна:
12 + 22 + ... + 102 = 385
Квадрат суммы первых десяти натуральных чисел равен:
(1 + 2 + ... + 10)2 = 552 = 3025
Разность между суммой квадратов и квадратом суммы первых десяти
натуральных чисел составляет:
3025 − 385 = 2640.
Найдите разность между суммой квадратов и квадратом суммы
первых ста натуральных чисел.
Чисел всего одна сотня, поэтому задача легко решается методом грубой
силы:
58

uses MathExtensions;

procedure Solve();
begin
// сумма чисел:
var sumNum := 0;
// сумма квадратов чисел:
var sumSqr := 0;
for var i := 1 to 100 do begin
// добавляем очередное число к сумме чисел:
sumNum += i;
//добавляем квадрат очередного числа к
// сумме квадратов чисел:
sumSqr += i*i;
end;
// печатаем ответ:
WriteLn($' Разность = {sumNum * sumNum - sumSqr}');
WriteLn;
end;

begin
Writeln(' Project Euler. Problem 6');
WriteLn;
Solve();
end.

Через пару миллисекунд вы получите полноценный ответ:
Project Euler. Problem 6
Разность = 25164150

Если бы чисел было в миллионы раз больше, то их сумму можно было бы
вычислить по формуле для суммы членов арифметической прогрессии:
n(n + 1)/2
59

И для суммы квадратов натуральных чисел также существует простая формула:
n(2n + 1)(n + 1)/6
Таким образом, при решении этой задачи можно обойтись вообще без
цикла, а сразу найти разность по формуле:
n*n(n + 1)(n + 1)/4 - n(2n + 1)(n + 1)/6 =
n(n + 1)/2 * (n(n + 1)/2 - (2n + 1)/3)
Записываем формулу в виде процедуры Solve2:
procedure Solve2();
begin
var n := 100;
var dif := n*(n + 1) div 2 * (n*(n + 1) div 2 - (2*n + 1) div 3);
// печатаем ответ:
WriteLn($' Разность = {dif}');
WriteLn;
end;

И вызываем её в главной программе:
begin
Writeln(' Project Euler. Problem 6');
WriteLn;
//Solve();
Solve2();
end.

60

Проект Эйлер007
Исходный код программы находится в файле Эйлер007.pas.

Шестая задача проверяет знания цикла for:
Задача номер 7 (Problem 7) называется 10001st prime. Она была опубликована 28 декабря 2001 года.
By listing the first six prime numbers: 2, 3, 5, 7, 11, and 13, we can see that the 6th
prime is 13.
What is the 10 001st prime number?
10001-ое простое число
Выписав первые шесть простых чисел, мы получим 2, 3, 5, 7, 11 и 13. Очевидно,
что 6-ое простое число - 13.
Какое число является 10001-ым простым числом?
Дело нужное и необходимое, поэтому добавляем в модуль MathExtensions
бесконечный генератор простых чисел:
/// Бесконечный генератор простых чисел
function GeneratePrimes(): sequence of int64;
begin
yield 2;
var primes := Lst(2);// new List<int64> [ 2 ];
var candidate: int64 := 3;
while True do begin
var isPrime := true;
var limit := int64(Sqrt(candidate));
foreach var p in primes do begin
if (p > limit) then break;
if (candidate mod p = 0) then begin
61

isPrime := false;
break;
end;
end;
if (isPrime) then begin
primes.Add(candidate);
yield candidate;
end;
// проверяем только нечётные:
candidate += 2;
end;
end;

После этой добавки решать практически нечего:
uses MathExtensions;
procedure Solve();
begin
var count := 0;
foreach var prime in GeneratePrimes() do begin
count += 1;
if (count = 10001) then begin
// печатаем ответ:
Writeln($' 10001-е простое число = {prime}');
break;
end;
end;
WriteLn;
end;

begin
Writeln(' Project Euler. Problem 7');
WriteLn;
Solve();
end.

А 10001-е простое число оказалось совсем небольшим!
62

Project Euler. Problem 7
10001-е простое число = 104743

Проект Эйлер008
Исходный код программы находится в файле Эйлер008.pas.

Задача номер 8 (Problem 8) называется Largest product in a series. Она
была опубликована 11 января 2002 года.
Find the greatest product of five consecutive digits in the 1000-digit number.
73167176531330624919225119674426574742355349194934
96983520312774506326239578318016984801869478851843
85861560789112949495459501737958331952853208805511
12540698747158523863050715693290963295227443043557
66896648950445244523161731856403098711121722383113
62229893423380308135336276614282806444486645238749
30358907296290491560440772390713810515859307960866
70172427121883998797908792274921901699720888093776
65727333001053367881220235421809751254540594752243
52584907711670556013604839586446706324415722155397
53697817977846174064955149290862569321978468622482
83972241375657056057490261407972968652414535100474
82166370484403199890008895243450658541227588666881
16427171479924442928230863465674813919123162824586
17866458359124566529476545682848912883142607690042
24219022671055626321111109370544217506941658960408
07198403850962455444362981230987879927244284909188
84580156166097919133875499200524063689912560717606
63

05886116467109405077541002256983155200055935729725
71636269561882670428252483600823257530420752963450
Наибольшее произведение в последовательности
Найдите максимальное произведение пяти последовательных цифр
(точнее, однозначных чисел) в 1000-значном числе.
Самое простое решение может быть таким.
1. Начиная с первой цифры, находим произведение пяти цифр. Полагаем его
максимальным.
2. Переходим ко второй цифре и снова вычисляем произведение пяти цифр.
Если оно больше текущего максимального, то устанавливаем новое максимальное произведение.
3. Переходим к третьей цифре – и так далее, пока не достигнем цифры 10005+1=996.
4. Найденное максимальное произведение и есть ответ на задачу.
«Картинно» наш алгоритм можно представить так:

Поскольку заданное число очень большое, то единственный тип данных,
который может хранить его, это строка:
// строка цифр:
var
64

str := '73167176531330624919225119674426574742355349194934' +
'96983520312774506326239578318016984801869478851843' +
'85861560789112949495459501737958331952853208805511' +
'12540698747158523863050715693290963295227443043557' +
'66896648950445244523161731856403098711121722383113' +
'62229893423380308135336276614282806444486645238749' +
'30358907296290491560440772390713810515859307960866' +
'70172427121883998797908792274921901699720888093776' +
'65727333001053367881220235421809751254540594752243' +
'52584907711670556013604839586446706324415722155397' +
'53697817977846174064955149290862569321978468622482' +
'83972241375657056057490261407972968652414535100474' +
'82166370484403199890008895243450658541227588666881' +
'16427171479924442928230863465674813919123162824586' +
'17866458359124566529476545682848912883142607690042' +
'24219022671055626321111109370544217506941658960408' +
'07198403850962455444362981230987879927244284909188' +
'84580156166097919133875499200524063689912560717606' +
'05886116467109405077541002256983155200055935729725' +
'71636269561882670428252483600823257530420752963450';

Для числа сомножителей мы введём ещё одну глобальную переменную
типа integer:
// число сомножителей:
var
k := 5;

Это вполне разумно, хотя и не требуется для решения задачи. Если вы захотите решить задачу при другом значении k, то просто исправьте эту строку
(но не забывайте, что произведение цифр может оказаться очень большим).
В главной программе мы просто вызываем процедуру SolveSimple, которая
и решает задачу:
begin
Writeln(' Project Euler. Problem 8');
WriteLn;
SolveSimple();
65

end.

Процедуру SolveSimple мы начинаем с того, что определяем две переменные, в которых будем хранить наибольшее произведение и его начальный
индекс в строке (для решения задачи эта информация не нужна, но всё
равно любопытно):
// РЕШАЕМ ЗАДАЧУ ПРОСТЫМ СПОСОБОМ
procedure SolveSimple();
begin
// наибольшее произведение:
var bigMul: int64 := 0;
// начальный индекс:
var maxId := 0;

Дальше мы кодируем наш простой алгоритм, то есть последовательно находим произведения k соседних чисел, печатаем их на экране и запоминаем
наибольшее из найденных произведений в переменной bigMul. А в переменной maxId храним индекс первого сомножителя «рекордного» произведения. Тут важно отметить, что в строке может оказаться и несколько последовательностей цифр с одинаковым максимальным произведением.
Естественно, мы запомним в maxId начало только первой из них.
Решаем последний вопрос: как извлекать цифры (однозначные числа) из
заданной строки str? – Есть, по крайней мере, два способа. Первый: извлечь
символ с индексом i+j, преобразовать его в строку, а затем в число:
mul *= integer.Parse(str[i+j].ToString());

Второй: извлечь нужный символ, найти его код и вычесть из него код нуля:
mul *= (Ord(str[i + j]) - Ord('0'));

66

Результат будет в точности равен однозначному числу, представленному
символом str[i+j]. По окончании работы процедура напечатает значения
переменных bigMul и maxId:
// находим произведение всех групп
// из k чисел в строке:
for var i := 1 to str.Length - k do begin
var mul: int64 := 1;
// находим произведение первых k чисел:
for var j := 0 to k - 1 do begin
//mul *= integer.Parse(str[i+j].ToString());
mul *= (Ord(str[i + j]) - Ord('0'));
end;
// печатаем текущее произведение:
WriteLn(mul);
if (mul > bigMul) then begin
bigMul := mul;
maxId := i;
end
end;
Writeln($' Наибольшее произведение = {bigMul}');
Writeln($' Начинается с индекса
{maxId}');
Writeln;
end;

Project Euler. Problem 8
882
126
294
1764
1470
630
630
270
135
0
0
0
0
0
67

432
...

1050
0
0
0
0
0
0
0
0
3780
1620
1296
3240
Наибольшее произведение = 40824
Начинается с индекса
365

Как вы видите, что очень много произведений равно нулю. И это легко объяснить: если хотя бы одно из k чисел – нуль, то и всё произведение будет
равно нулю. Поэтому мы можем решить задачу «изящнее», если разобьём
исходную строку на подстроки, не содержащие нулей. Тогда нам не придётся вычислять лишние произведения.
В новой процедуре Solve мы делим заданную строку str на подстроки с помощью метода Split, которому указываем, что разделителем подстрок служит символ нуль:
// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
// разбиваем исходную строку на подстроки,
// не содержащие нулей:
var astr := str.Split(|'0'|);
// наибольшее произведение:
var bigMul: int64 := 0;

В итоге мы получим 98 подстрок (для этой задачи, естественно), которые
хранятся в строковом массиве astr:
68

В цикле foreach перебираем эти подстроки, и если окажется, что длина какой-либо подстроки меньше k, то мы пропускаем её: она либо находится в
конце строки str, либо следующий символ в строке str - нуль. Если же всё
нормально, то мы находим в функции SolveSubstr максимальное произведение mul для этой подстроки и при необходимости корректируем значение переменной bigMul. Завершаем процедуру печатью найденного максимального произведения:
// находим макс. произведение в каждой строке:
foreach var s in astr do begin
// если подстрока короче k,
// то пропускаем её:
if (s.Length < k) then
continue;
//Write(s + ' > ');
var mul := SolveSubstr(s);
//WriteLn(mul);
if (mul > bigMul) then
bigMul := mul;
end;
Writeln($' Наибольшее произведение = {bigMul}');
Writeln;
end;

Функция SolveSubstr получает подстроку s и для начала находит произведение k первых цифр:

function SolveSubstr(s: string): int64;
begin
var res: int64 := 1;
69

var max: int64 := 0;
var maxId := 0;
// находим произведение первых k чисел:
for var i := 1 to k do
res *= (Ord(s[i]) - Ord('0'));

Полученное произведение становится максимальным для подстроки:
// запоминаем результат:
max := res;

Индекс первой цифры этой группы равен единице, что мы и запоминаем в
переменной ptr:
// начало диапазона из k чисел:
var ptr := 1;

Дальше мы действуем, как в простом алгоритме, но находим новое произведение так: делим значение переменной res на число в начале группы, а
затем умножаем результат на число, которое находится за последним числом группы. Произведение всех остальных чисел в новой группе находить
уже не нужно:
while (ptr + k <= s.Length) do begin
// делим произведение на
// первое число диапазона:
res := res div (Ord(s[ptr]) - Ord('0'));
// и умножаем на следующее
// за концом диапазона:
res *= (Ord(s[ptr + k]) - Ord('0'));
if (res > max) then begin
max := res;
maxId := ptr;
end;
ptr += 1;
end;
Result := max;
end;
70

Произведение первых k=5 чисел равно 7 x 6 x 9 x 8 x 3 = 9072. После деления на 7 переменная res получит значение 9072 : 7 = 1296, а после умножения на 1 новое произведение res будет равно 1296 x 1 = 1296.

Затем указатель ptr сдвигается вправо - на следующее число, и так далее.

Результат решения восьмой задачи, естественно, мы получим тот же самый,
что и в первом случае.
Вот «подстрочное» решение задачи:
Project Euler. Problem 8
Наибольшее произведение = 40824
Начинается с индекса
365
7316717653133 > 1764
6249192251196744265747423553491949349698352 > 15552
3127745 > 1960
6326239578318 > 7560
. . .
71

6585412275886668811642717147992444292823 > 13824
863465674813919123162824586178664583591245665294765456828489128831426 >
8064
4224219 > 144
22671 > 168
556263211111 > 1800
5442175 > 280
694165896 > 12960
71984 > 2016
96245544436298123 > 2592
9878799272442849 > 31752
91888458 > 10240
156166 > 1080
979191338754992 > 11340
6368991256 > 11664
58861164671 > 1920
77541 > 980
22569831552 > 6480
559357297257163626956188267 > 5376
4282524836 > 1152
82325753 > 1050
75296345 > 3780
Наибольшее произведение = 40824

Оба алгоритма справляются с задачей мгновенно, поэтому давайте сравним
скорость их работы на огромном исходном числе. Для этого в главной программе создадим строку из 10 миллионов цифр:
begin
Writeln(' Project Euler. Problem 8');
WriteLn;
// формируем строку цифр:
CreateString(10000000);
var start := Milliseconds();
SolveSimple();
WriteLn($' Метод SolveSimple: {Milliseconds - start} ms');
WriteLn;
start := Milliseconds();
Solve();
WriteLn($' Метод Solve:
{Milliseconds - start} ms');
WriteLn;
end.
72

Сделать это совсем нетрудно:
procedure CreateString(len : integer);
begin
Randomize;
var sb := new StringBuilder(len);
for var i := 0 to len-1 do begin
var n := Random(10);
sb.Append(n);
end;
str := sb.ToString();
end;

По очереди решаем задачу двумя способами и получаем такой результат:
Project Euler. Problem 8
Наибольшее произведение = 59049
Начинается с индекса
49294
Метод SolveSimple: 607 ms
Наибольшее произведение = 59049
Метод Solve:

413 ms

Из него следует, что решение задачи нужно заканчивать, если найдено максимально возможное произведение. Как легко догадаться, для пяти последовательных цифр произведение не может быть больше, чем 95= 59049. В
длинных строках пять девяток встретятся непременно.
Не забудьте отключить печать промежуточных результатов в подпрограммах SolveSimple, Solve и SolveSubstr, иначе
вам придётся ждать, пока они напечатают миллионы
строк!

73

В новой версии этой задачи требуется найти произведение не пяти, а тринадцати цифр! Чтобы решить обновлённую задачу, исправьте значение переменной k:
// число сомножителей:
var
k := 13;//5;

И этот вариант задачи оказался для компьютера лёгкой числовой прогулкой:
Project Euler. Problem 8
Наибольшее произведение = 23514624000
Начинается с индекса
198
Метод SolveSimple: 1 ms
Наибольшее произведение = 23514624000
Метод Solve:

1 ms

Проект Эйлер009
Исходный код программы находится в файле Эйлер009.pas.

Эта задача тесно связана с пифагоровыми тройками чисел:
Задача номер 9 (Problem 9) называется Special Pythagorean triplet. Она
была опубликована 25 января 2002 года.

74

A Pythagorean triplet is a set of three natural numbers, a < b < c, for which, a 2 + b2
= c2. For example, 32 + 42 = 9 + 16 = 25 = 52.
There exists exactly one Pythagorean triplet for which a + b + c = 1000.
Find the product abc.
Особая Пифагорова тройка чисел
Найдите пифагорову тройку чисел (не обязательно простейшую!), для которой выполняется условие:
a + b + c = 1000
(1)
То есть периметр треугольника должен равняться тысяче.
Решением задачи является произведение длин сторон abc.
Чтобы вычислить произведение сторон, нужно сначала их найти. Совершенно очевидно, что катеты не могут быть меньше 1 и больше 1000. Также
мы знаем, что один катет больше другого. Так как в условии задачи утверждается, что пифагорова тройка, для которой выполняется условие (1), –
единственная, то нам достаточно найти её и тут же прекратить дальнейшие поиски.
Периметр лучше задать константой SUM, чтобы при необходимости выбрать другое значение:
uses MathExtensions;
// сумма длин сторон:
const
SUM = 1000;

В главной программе вызываем процедуру Solve1 для решения задачи простым перебором:
begin
Writeln(' Project Euler. Problem 9');
Writeln;
Solve1();
end.
75

К счастью (или к несчастью?), возможности современных компьютеров таковы, что перебрать сотни тысяч вариантов для них – пустяковая задача.
Поэтому мы организуем два цикла for, в которых зададим катетам все возможные значения. Длину гипотенузы находим по формуле Пифагора.
Если окажется, что сумма длин сторон равна заданной SUM, то мы напечатаем решение задачи на экране и возвратимся в главную программу:
// РЕШАЕМ ЗАДАЧУ ПЕРВЫМ СПОСОБОМ
procedure Solve1();
begin
for var a := 1 to SUM - 1 do begin
for var b := a + 1 to SUM - 1 do begin
var summa := a + b + Sqrt(a * a + b * b);
//Writeln($' summa = {summa}');
if (summa > SUM) then
break;
if (summa = SUM) then begin
Writeln($' a = {a}');
Writeln($' b = {b}');
Writeln($' c = {SUM - a - b}');
Writeln($' abc = {a * b * (SUM - a - b)}');
WriteLn;
exit;
end
end;
end;
end;

Запускаем программу и тут же читаем ответ на задачу:
Project Euler. Problem 9
a =
b =
c =
abc

200
375
425
= 31875000

Можно обойтись и одним циклом, если из системы уравнений:
76

a2 + b2 = c2
a + b + c = SUM
выразить a через b:
SUM(SUM-2b)
a = ------------2(SUM-b)
Тогда второй способ решения задачи становится ещё проще:
// РЕШАЕМ ЗАДАЧУ ВТОРЫМ СПОСОБОМ
procedure Solve2();
begin
for var b:= 1 to SUM div 2 -1 do begin
var a:= SUM * (SUM - 2 * b) div 2 div (SUM - b);
var summa := a + b + Sqrt(a * a + b * b);
//Writeln($' summa = {summa}');
if (summa = SUM) then begin
Writeln($' a = {a}');
Writeln($' b = {b}');
Writeln($' c = {SUM - a - b}');
Writeln($' abc = {a * b * (SUM - a - b)}');
WriteLn;
exit;
end;
end
end;

Пифагоровы тройки чисел могут понадобиться при решении других задач,
поэтому добавляем в модуль MathExtensions новую функцию:
/// ГЕНЕРИРУЕТ ПИФАГОРОВЫ ТРОЙКИ ЧИСЕЛ
function PythagoreanTriplesGen(maxC: int): sequence of (int, int, int);
begin
for var m := 2 to Trunc(Sqrt(maxC)) + 1 do
for var n := 1 to m - 1 do begin
if (m - n) mod 2 = 1 then begin
77

var a := m * m - n * n;
var b := 2 * m * n;
var c := m * m + n * n;
if c <= maxC then begin
if a > b then Swap(a, b);
yield (a, b, c);
end;
end;
end;
end;

С ней решение задачи ещё более упрощается:
// РЕШАЕМ ЗАДАЧУ С ГЕНЕРАТОРОМ
procedure Solve3();
begin
foreach var (a, b, c) in PythagoreanTriplesGen(500) do begin
var summa := a + b + c;
//Writeln($' summa = {summa}');
if (summa = SUM) then begin
Writeln($' summa = {summa}');
Writeln($' a = {a}');
Writeln($' b = {b}');
Writeln($' c = {c}');
Writeln($' abc = {a * b * c}');
WriteLn;
break;
end;
end;
end;

Всеми способами задача решается очень быстро:
Project Euler. Problem 9
a =
b =
c =
abc

200
375
425
= 31875000
78

a =
b =
c =
abc

375
200
425
= 31875000

summa = 1000
a = 200
b = 375
c = 425
abc = 31875000

Если подумать…
А теперь давайте убедимся, что не зря потратили время на изучение теории.
Воспользуемся формулами:
a = mn
b = (m2-n2)/2
c = (m2+n2)/2

(2)

Тогда:
SUM = a + b + c = mn + (m2-n2)/2 + (m2+n2)/2
Или после простых преобразований:
SUM = m(m+n) = 1000
Из этого уравнения в уме находим:
m = 25
n = 15 (так как 25 x 40 = 1000)
И:
a = mn = 25 x 15 = 375
b = (m2-n2)/2 = (625-225)/2 = 200
c = 1000 – 375 – 200 = 425
Таким образом, перебор значений переменных m и n сократился настолько,
что его можно провести вообще без компьютера. А вывод такой: не спешите
79

писать программу для компьютера – может оказаться, что она имеет простое решение для устного счёта! И конечно, изучайте математику!

Проект Эйлер010
Исходный код программы находится в файле Эйлер010.pas.

Очередная задача на простые числа:
Задача номер 10 (Problem 10) называется Summation of primes. Она была
опубликована 8 февраля 2002 года.
Условие задачи на английском языке:
The sum of the primes below 10 is 2 + 3 + 5 + 7 = 17.
Find the sum of all the primes below two million
Сложение простых чисел
Найдите сумму всех простых чисел, которые меньше 2 000 000.
Опять доверяем решение задачи процедуре Solve:
begin
Writeln(' Project Euler. Problem 10');
Writeln;
Solve();
end.

Поскольку у нас уже есть генератор простых чисел, то пропускаем через
него дальше только простые числа, которые меньше двух миллионов, и
находим их сумму:
80

uses MathExtensions;

// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
var sum := GeneratePrimes
.TakeWhile(p -> p < 2_000_000)
.Sum;
Writeln($' Сумма равна: {sum}');
end;

В некоторых случаях, то есть иногда может потребоваться такой генератор
простых чисел:
/// Быстрый генератор простых чисел
function OptimizedPrimeGen(limit: int64): sequence of int64;
begin
if limit < 2 then exit;
// создаём массив размером limit+1:
var isPrime := new boolean[limit + 1];
for var i := 2 to limit do
isPrime[i] := true;
// первое простое число:
yield 2;
// только нечётные числа:
var sqrtLimit := Trunc(Sqrt(limit));
for var i := 3 to sqrtLimit step 2 do begin
if isPrime[i] then begin
// начинаем с i*i, шаг = 2*i
// (только нечётные кратные):
var step := i * 2;
var j := i * i;
while j <= limit do begin
isPrime[j] := false;
j += step;
end;
end;
81

end;
// возвращаем оставшиеся простые числа&
for var i := 3 to limit step 2 do
if isPrime[i] then
yield i;
end;

С ним решение задачи упрощается и укорачивается ещё больше:
procedure Solve2();
begin
var sum := OptimizedPrimeGen(2_000_000)
.Sum;
Writeln($' Сумма равна: {sum}');
end;

begin
Writeln(' Project Euler. Problem 10');
Writeln;
Solve();
Solve2();
end.

А сумма оказалась совсем немаленькая:
Project Euler. Problem 10
Сумма равна: 142913828922
Сумма равна: 142913828922

82

Проект Эйлер011
Исходный код программы находится в файле Эйлер011.pas.

Боремся с гигантской матрицей!
Задача 11 (Problem 11) Largest product in a grid была опубликована 22 февраля 2002 года.
Условие задачи на английском языке:
In the 20×20 grid below, four numbers along a diagonal line have been marked in
red.
08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08
49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00
81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65
52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91
22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80
24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50
32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70
67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21
24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72
21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95
78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92
16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57
86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58
19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40
04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66
88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69
04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36
20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16
20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54
01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48
The product of these numbers is 26 × 63 × 78 × 14 = 1788696.
83

What is the greatest product of four adjacent numbers in the same direction (up,
down, left, right, or diagonally) in the 20×20 grid?
Наибольшее произведение в таблице
В таблице 20×20 клетки четыре числа на одной из диагоналей выделены
красным цветом. Произведение этих чисел: 26 × 63 × 78 × 14 = 1788696.
Каково наибольшее произведение четырёх подряд идущих чисел в таблице 20×20, расположенных в любом направлении (вверх, вниз, вправо,
влево или по диагонали)?
Таблицу с числами удобно представить в виде динамического массива
массивов:
uses MathExtensions;
var grid
|08, 02,
|49, 49,
|81, 49,
|52, 70,
|22, 31,
|24, 47,
|32, 98,
|67, 26,
|24, 55,
|21, 36,
|78, 17,
|16, 39,
|86, 56,
|19, 80,
|04, 52,
|88, 36,
|04, 42,
|20, 69,
|20, 73,
|01, 70,

:= |
22, 97,
99, 40,
31, 73,
95, 23,
16, 71,
32, 60,
81, 28,
20, 68,
58, 05,
23, 09,
53, 28,
05, 42,
00, 48,
81, 68,
08, 83,
68, 87,
16, 73,
36, 41,
35, 29,
54, 71,

38,
17,
55,
04,
51,
99,
64,
02,
66,
75,
22,
96,
35,
05,
97,
57,
38,
72,
78,
83,

15,
81,
79,
60,
67,
03,
23,
62,
73,
00,
75,
35,
71,
94,
35,
62,
25,
30,
31,
51,

00,
18,
14,
11,
63,
45,
67,
12,
99,
76,
31,
31,
89,
47,
99,
20,
39,
23,
90,
54,

40,
57,
29,
42,
89,
02,
10,
20,
26,
44,
67,
47,
07,
69,
16,
72,
11,
88,
01,
69,

00,
60,
93,
69,
41,
44,
26,
95,
97,
20,
15,
55,
05,
28,
07,
03,
24,
34,
74,
16,

75,
87,
71,
24,
92,
75,
38,
63,
17,
45,
94,
58,
44,
73,
97,
46,
94,
62,
31,
92,

04,
17,
40,
68,
36,
33,
40,
94,
78,
35,
03,
88,
44,
92,
57,
33,
72,
99,
49,
33,

05,
40,
67,
56,
54,
53,
67,
39,
78,
14,
80,
24,
37,
13,
32,
67,
18,
69,
71,
48,

07,
98,
53,
01,
22,
78,
59,
63,
96,
00,
04,
00,
44,
86,
16,
46,
08,
82,
48,
61,

78,
43,
88,
32,
40,
36,
54,
08,
83,
61,
62,
17,
60,
52,
26,
55,
46,
67,
86,
43,

52,
69,
30,
56,
40,
84,
70,
40,
14,
33,
16,
54,
21,
17,
26,
12,
29,
59,
81,
52,

12,
48,
03,
71,
28,
20,
66,
91,
88,
97,
14,
24,
58,
77,
79,
32,
32,
85,
16,
01,

50,
04,
49,
37,
66,
35,
18,
66,
34,
34,
09,
36,
51,
04,
33,
63,
40,
74,
23,
89,

77,
56,
13,
02,
33,
17,
38,
49,
89,
31,
53,
29,
54,
89,
27,
93,
62,
04,
57,
19,

91,
62,
36,
36,
13,
12,
64,
94,
63,
33,
56,
85,
17,
55,
98,
53,
76,
36,
05,
67,

08|,
00|,
65|,
91|,
80|,
50|,
70|,
21|,
72|,
95|,
92|,
57|,
58|,
40|,
66|,
69|,
36|,
16|,
54|,
48||;

В процедуре Solve проходим по всем числам таблицы, начиная с верхнего
левого и заканчивая нижним правым:
84

// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
// число строк и колонок в таблице:
var rows := grid.Length;
var cols := grid[0].Length;
// макс. произведение:
var maxp := 0;
// по всем строкам:
for var r := 0 to rows-1 do begin
// по вcем колонкам:
for var c := 0 to cols-1 do begin

Все 4 числа должны находиться на одной прямой, которая начинается в
клетке с текущим числом и продолжается по горизонтали вправо, по вертикали вниз, по диагонали вправо вниз и по диагонали влево вниз.

85

Если от текущего числа в клетке с координатами (r, c) справа имеется ещё
3 числа, то мы находим их произведение и сравниваем с текущим значением наибольшей суммы maxp. Если новое произведение окажется больше,
то значение переменной maxp обновится:
// горизонталь вправо:
if (c < cols - 3) then begin
maxp := Max(maxp,
grid[r, c] *
grid[r, c + 1] *
grid[r, c + 2] *
grid[r, c + 3]);
end;

Если от текущего числа вниз имеется ещё 3 числа, то мы находим их произведение, а дальше поступаем, как в предыдущем случае:
// вертикаль вниз:
if (r < rows - 3) then begin
maxp := Max(maxp,
grid[r, c] *
grid[r + 1, c] *
grid[r + 2, c] *
grid[r + 3, c]);
end;

Аналогично находим произведения четырёх чисел по нисходящей и восходящей диагоналям от текущего числа:
// диагональ вниз вправо:
if (r < rows - 3) and (c < cols
maxp := Max(maxp,
grid[r, c] *
grid[r + 1, c +
grid[r + 2, c +
grid[r + 3, c +
end;

- 3) then begin

1] *
2] *
3]);

// диагональ вниз влево:
86

if (r < rows - 3) and (c > 3)
maxp := Max(maxp,
grid[r, c] *
grid[r + 1, c
grid[r + 2, c
grid[r + 3, c
end;

then begin

- 1] *
- 2] *
- 3]);

end;
end;
Writeln($' Наибольшее произведение = {maxp}');
Writeln;
end;

begin
Writeln(' Project Euler. Problem 11');
Writeln;
Solve();
end.

А вот и ответ на задачу:
Project Euler. Problem 11
Наибольшее произведение = 70600674

Проект Эйлер012
Исходный код программы находится в файле Эйлер012.pas.

Задача 12 (Problem 12) Largest product in a grid была опубликована 8 марта
2002 года.
Условие задачи на английском языке:
87

The sequence of triangle numbers is generated by adding the natural numbers. So
the 7th triangle number would be 1 + 2 + 3 + 4 + 5 + 6 + 7 = 28. The first ten terms
would be:
1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...
Let us list the factors of the first seven triangle numbers:
1: 1
3: 1,3
6: 1,2,3,6
10: 1,2,5,10
15: 1,3,5,15
21: 1,3,7,21
28: 1,2,4,7,14,28
We can see that 28 is the first triangle number to have over five divisors.
What is the value of the first triangle number to have over five hundred divisors?
Треугольное число с большим количеством делителей
Последовательность треугольных чисел образуется путем сложения натуральных чисел. К примеру, 7-ое треугольное число равно 1 + 2 + 3 + 4 + 5 + 6 +
7 = 28. Первые десять треугольных чисел:
1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...
Перечислим делители первых семи треугольных чисел:
1: 1
3: 1, 3
6: 1, 2, 3, 6
10: 1, 2, 5, 10
15: 1, 3, 5, 15
21: 1, 3, 7, 21
28: 1, 2, 4, 7, 14, 28

88

Как вы видите, 28 - первое треугольное число, у которого более пяти делителей.
Найдите первое треугольное число, у которого более пятисот делителей.
Добавляем в модуль MathExtensions простую функцию для вычисления
треугольного числа по его номеру:
function Tri(n : int): int64;
begin
if (n <= 1) then begin
Result := n;
exit;
end;
Result := n * (n + 1) div 2;
end;

Туда же добавляем метод расширения для чисел типа int64, который возвращает число всех делителей:
// ВОЗВРАЩАЕТ ЧИСЛО ВСЕХ ДЕЛИТЕЛЕЙ ЧИСЛА
function DivisorCount(self: int64): integer; extensionmethod;
begin
if self = 0 then
exit(0); // бесконечное число
var n := Abs(self);
var count := 2; // 1 и само число
for var i := 2 to Trunc(Sqrt(n)) do begin
if n mod i = 0 then begin
count := count + 1; // i
if i * i <> n then
count := count + 1; // n div i
end;
end;
Result := count;
end;
89

Для интереса и саморазвития пишем метод расширения GetSortedDivisors,
который возвращает в отсортированном виде все делители заданного
числа:
// ВОЗВРАЩАЕТ ВСЕ ОТСОРТИРОВАННЫЕ ДЕЛИТЕЛИ ЧИСЛА ТИПА int64
function GetSortedDivisors(n: int64): sequence of int64;
begin
if n = 0 then begin
yield 0;
exit;
end;
n := Abs(n);
// список делителей:
var divisors := new List<int64>;
if n = 1 then begin
divisors.Add(1);
end
else begin
divisors.Add(1);
for var i := 2 to Trunc(Sqrt(n)) do begin
if n mod i = 0 then begin
divisors.Add(i);
var complement := n div i;
if complement <> i then
divisors.Add(complement);
end;
end;
divisors.Add(n);
end;
// сортируем и возвращаем:
divisors.Sort;
foreach var d in divisors do
yield d;
end;

Теперь у нас всё готово для решения задачи!
Переменная i хранит номер треугольного числа:
90

uses MathExtensions;

// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
var i: int64 := 0;

В бесконечном цикле while последовательно получаем от функции Tri треугольные числа:
while True do begin
i += 1;
var t := Tri(i);

Метод расширения DivisorCount подсчитывает все делители очередного
треугольного числа:
var dc := t.DivisorCount;

Как только их число превысит 500, мы напечатаем все делители и само треугольное число:
if dc > 500 then begin
foreach var n in GetSortedDivisors(t) do
Write($' {n}');
Writeln;
Writeln($' Треугольное число = {t}');

На этом решение задачи заканчивается:
break;
end;
end;
91

Writeln;
end;

begin
Writeln(' Project Euler. Problem 12');
Writeln;
Solve();
end.

Запускаем программу, и она в считанные мгновения выдаёт ответ:
Project Euler. Problem 12
1 2 3 4 5 6 7 9 10 11 12 13 14 15 17 18 20 21 22 25 26 28 30 33 34 35 36
39 42 44 45 50 51 52 55 60 63 65 66 68 70 75 77 78 84 85 90 91 99 100 102
105 110 117 119 125 126 130 132 140 143 150 153 154 156 165 170 175 180
182 187 195 198 204 210 220 221 225 231 234 238 250 252 255 260 273 275
286 300 306 308 315 325 330 340 350 357 364 374 375 385 390 396 420 425
429 442 450 455 462 468 476 495 500 510 525 546 550 561 572 585 595 612
630 650 660 663 693 700 714 715 748 750 765 770 780 819 825 850 858 875
884 900 910 924 935 975 990 1001 1020 1050 1071 1092 1100 1105 1122 1125
1155 1170 1190 1260 1275 1287 1300 1309 1326 1365 1375 1386 1428 1430 1500
1530 1540 1547 1575 1625 1638 1650 1683 1700 1716 1750 1785 1820 1870 1925
1950 1980 1989 2002 2100 2125 2142 2145 2210 2244 2250 2275 2310 2340 2380
2431 2475 2550 2574 2618 2625 2652 2730 2750 2772 2805 2860 2925 2975 3003
3060 3094 3150 3250 3276 3300 3315 3366 3465 3500 3570 3575 3740 3825 3850
3900 3927 3978 4004 4095 4125 4250 4284 4290 4420 4500 4550 4620 4641 4675
4862 4875 4950 5005 5100 5148 5236 5250 5355 5460 5500 5525 5610 5775 5850
5950 6006 6188 6300 6375 6435 6500 6545 6630 6732 6825 6930 7140 7150 7293
7650 7700 7735 7854 7875 7956 8190 8250 8415 8500 8580 8925 9009 9100 9282
9350 9625 9724 9750 9900 9945 10010 10500 10710 10725 11050 11220 11375
11550 11700 11781 11900 12012 12155 12375 12750 12870 13090 13260 13650
13860 13923 14025 14300 14586 14625 14875 15015 15300 15470 15708 15750
16380 16500 16575 16830 17017 17325 17850 17875 18018 18564 18700 19125
19250 19500 19635 19890 20020 20475 21420 21450 21879 22100 22750 23100
23205 23375 23562 24310 24750 25025 25500 25740 26180 26775 27300 27625
27846 28050 28875 29172 29250 29750 30030 30940 31500 32175 32725 33150
33660 34034 34125 34650 35700 35750 36036 36465 38250 38500 38675 39270
39780 40950 42075 42900 43758 44625 45045 45500 46410 46750 47124 48620
49500 49725 50050 51051 53550 53625 55250 55692 56100 57750 58500 58905
59500 60060 60775 64350 65450 66300 68068 68250 69300 69615 70125 71500
92

72930 75075 76500 77350 78540 81900 82875 84150 85085 86625 87516 89250
90090 92820 93500 98175 99450 100100 102102 102375 107100 107250 109395
110500 115500 116025 117810 121550 125125 128700 130900 133875 136500
139230 140250 145860 150150 153153 154700 160875 163625 165750 168300
170170 173250 178500 180180 182325 193375 196350 198900 204204 204750
210375 214500 218790 225225 232050 235620 243100 248625 250250 255255
267750 278460 280500 294525 300300 303875 306306 321750 327250 331500
340340 346500 348075 364650 375375 386750 392700 409500 420750 425425
437580 450450 464100 490875 497250 500500 510510 535500 546975 580125
589050 607750 612612 643500 654500 696150 729300 750750 765765 773500
841500 850850 900900 911625 981750 994500 1021020 1093950 1126125 1160250
1178100 1215500 1276275 1392300 1472625 1501500 1531530 1701700 1740375
1823250 1963500 2127125 2187900 2252250 2320500 2552550 2734875 2945250
3063060 3480750 3646500 3828825 4254250 4504500 5105100 5469750 5890500
6381375 6961500 7657650 8508500 10939500 12762750 15315300 19144125
25525500 38288250 76576500
Треугольное число = 76576500

Проект Эйлер013
Исходный код программы находится в файле Эйлер013.pas.

Задача 13 (Problem 13) Largest product in a grid была опубликована 22
марта 2002 года.
Условие задачи на английском языке:
Work out the first ten digits of the sum of the following one-hundred 50-digit numbers.
37107287533902102798797998220837590246510135740250
46376937677490009712648124896970078050417018260538
74324986199524741059474233309513058123726617309629
91942213363574161572522430563301811072406154908250
23067588207539346171171980310421047513778063246676
93

89261670696623633820136378418383684178734361726757
28112879812849979408065481931592621691275889832738
44274228917432520321923589422876796487670272189318
47451445736001306439091167216856844588711603153276
70386486105843025439939619828917593665686757934951
62176457141856560629502157223196586755079324193331
64906352462741904929101432445813822663347944758178
92575867718337217661963751590579239728245598838407
58203565325359399008402633568948830189458628227828
80181199384826282014278194139940567587151170094390
35398664372827112653829987240784473053190104293586
86515506006295864861532075273371959191420517255829
71693888707715466499115593487603532921714970056938
54370070576826684624621495650076471787294438377604
53282654108756828443191190634694037855217779295145
36123272525000296071075082563815656710885258350721
45876576172410976447339110607218265236877223636045
17423706905851860660448207621209813287860733969412
81142660418086830619328460811191061556940512689692
51934325451728388641918047049293215058642563049483
62467221648435076201727918039944693004732956340691
15732444386908125794514089057706229429197107928209
55037687525678773091862540744969844508330393682126
18336384825330154686196124348767681297534375946515
80386287592878490201521685554828717201219257766954
78182833757993103614740356856449095527097864797581
16726320100436897842553539920931837441497806860984
48403098129077791799088218795327364475675590848030
87086987551392711854517078544161852424320693150332
59959406895756536782107074926966537676326235447210
69793950679652694742597709739166693763042633987085
41052684708299085211399427365734116182760315001271
65378607361501080857009149939512557028198746004375
35829035317434717326932123578154982629742552737307
94953759765105305946966067683156574377167401875275
88902802571733229619176668713819931811048770190271
25267680276078003013678680992525463401061632866526
36270218540497705585629946580636237993140746255962
94

24074486908231174977792365466257246923322810917141
91430288197103288597806669760892938638285025333403
34413065578016127815921815005561868836468420090470
23053081172816430487623791969842487255036638784583
11487696932154902810424020138335124462181441773470
63783299490636259666498587618221225225512486764533
67720186971698544312419572409913959008952310058822
95548255300263520781532296796249481641953868218774
76085327132285723110424803456124867697064507995236
37774242535411291684276865538926205024910326572967
23701913275725675285653248258265463092207058596522
29798860272258331913126375147341994889534765745501
18495701454879288984856827726077713721403798879715
38298203783031473527721580348144513491373226651381
34829543829199918180278916522431027392251122869539
40957953066405232632538044100059654939159879593635
29746152185502371307642255121183693803580388584903
41698116222072977186158236678424689157993532961922
62467957194401269043877107275048102390895523597457
23189706772547915061505504953922979530901129967519
86188088225875314529584099251203829009407770775672
11306739708304724483816533873502340845647058077308
82959174767140363198008187129011875491310547126581
97623331044818386269515456334926366572897563400500
42846280183517070527831839425882145521227251250327
55121603546981200581762165212827652751691296897789
32238195734329339946437501907836945765883352399886
75506164965184775180738168837861091527357929701337
62177842752192623401942399639168044983993173312731
32924185707147349566916674687634660915035914677504
99518671430235219628894890102423325116913619626622
73267460800591547471830798392868535206946944540724
76841822524674417161514036427982273348055556214818
97142617910342598647204516893989422179826088076852
87783646182799346313767754307809363333018982642090
10848802521674670883215120185883543223812876952786
71329612474782464538636993009049310363619763878039
62184073572399794223406235393808339651327408011116
95

66627891981488087797941876876144230030984490851411
60661826293682836764744779239180335110989069790714
85786944089552990653640447425576083659976645795096
66024396409905389607120198219976047599490197230297
64913982680032973156037120041377903785566085089252
16730939319872750275468906903707539413042652315011
94809377245048795150954100921645863754710598436791
78639167021187492431995700641917969777599028300699
15368713711936614952811305876380278410754449733078
40789923115535562561142322423255033685442488917353
44889911501440648020369068063960672322193204149535
41503128880339536053299340368006977710650566631954
81234880673210146739058568557934581403627822703280
82616570773948327592232845941706525094512325230608
22918802058777319719839450180888072429661980811197
77158542502016545090413245809786882778948721859617
72107838435069186155435662884062257473692284509516
20849603980134001723930671666823555245252804609722
53503534226472524250874054075591789781264330331690
Большая сумма
Найдите первые десять цифр суммы ста 50-значных чисел.
Единственная проблема при решении этой задачи – найти тип данных, который мог бы хранить числа такой длины. К счастью, в паскале имеется
структура BigInteger для работы с целыми числами любой разрядности.
Исходные числа мы должны представить в программе в виде строк, которые затем конвертируем в большие числа методом Parse. Для удобства все
числа сохраним в массиве numbers:
uses MathExtensions;
var numbers := |
BigInteger.Parse('37107287533902102798797998220837590246510135740250'),
BigInteger.Parse('46376937677490009712648124896970078050417018260538'),
BigInteger.Parse('74324986199524741059474233309513058123726617309629'),
BigInteger.Parse('91942213363574161572522430563301811072406154908250'),
96

BigInteger.Parse('23067588207539346171171980310421047513778063246676'),
BigInteger.Parse('89261670696623633820136378418383684178734361726757'),
BigInteger.Parse('28112879812849979408065481931592621691275889832738'),
BigInteger.Parse('44274228917432520321923589422876796487670272189318'),
BigInteger.Parse('47451445736001306439091167216856844588711603153276'),
BigInteger.Parse('70386486105843025439939619828917593665686757934951'),
BigInteger.Parse('62176457141856560629502157223196586755079324193331'),
BigInteger.Parse('64906352462741904929101432445813822663347944758178'),
BigInteger.Parse('92575867718337217661963751590579239728245598838407'),
BigInteger.Parse('58203565325359399008402633568948830189458628227828'),
BigInteger.Parse('80181199384826282014278194139940567587151170094390'),
BigInteger.Parse('35398664372827112653829987240784473053190104293586'),
BigInteger.Parse('86515506006295864861532075273371959191420517255829'),
BigInteger.Parse('71693888707715466499115593487603532921714970056938'),
BigInteger.Parse('54370070576826684624621495650076471787294438377604'),
BigInteger.Parse('53282654108756828443191190634694037855217779295145'),
BigInteger.Parse('36123272525000296071075082563815656710885258350721'),
BigInteger.Parse('45876576172410976447339110607218265236877223636045'),
BigInteger.Parse('17423706905851860660448207621209813287860733969412'),
BigInteger.Parse('81142660418086830619328460811191061556940512689692'),
BigInteger.Parse('51934325451728388641918047049293215058642563049483'),
BigInteger.Parse('62467221648435076201727918039944693004732956340691'),
BigInteger.Parse('15732444386908125794514089057706229429197107928209'),
BigInteger.Parse('55037687525678773091862540744969844508330393682126'),
BigInteger.Parse('18336384825330154686196124348767681297534375946515'),
BigInteger.Parse('80386287592878490201521685554828717201219257766954'),
BigInteger.Parse('78182833757993103614740356856449095527097864797581'),
BigInteger.Parse('16726320100436897842553539920931837441497806860984'),
BigInteger.Parse('48403098129077791799088218795327364475675590848030'),
BigInteger.Parse('87086987551392711854517078544161852424320693150332'),
BigInteger.Parse('59959406895756536782107074926966537676326235447210'),
BigInteger.Parse('69793950679652694742597709739166693763042633987085'),
BigInteger.Parse('41052684708299085211399427365734116182760315001271'),
BigInteger.Parse('65378607361501080857009149939512557028198746004375'),
BigInteger.Parse('35829035317434717326932123578154982629742552737307'),
BigInteger.Parse('94953759765105305946966067683156574377167401875275'),
BigInteger.Parse('88902802571733229619176668713819931811048770190271'),
BigInteger.Parse('25267680276078003013678680992525463401061632866526'),
BigInteger.Parse('36270218540497705585629946580636237993140746255962'),
BigInteger.Parse('24074486908231174977792365466257246923322810917141'),
BigInteger.Parse('91430288197103288597806669760892938638285025333403'),
BigInteger.Parse('34413065578016127815921815005561868836468420090470'),
BigInteger.Parse('23053081172816430487623791969842487255036638784583'),
BigInteger.Parse('11487696932154902810424020138335124462181441773470'),
BigInteger.Parse('63783299490636259666498587618221225225512486764533'),
97

BigInteger.Parse('67720186971698544312419572409913959008952310058822'),
BigInteger.Parse('95548255300263520781532296796249481641953868218774'),
BigInteger.Parse('76085327132285723110424803456124867697064507995236'),
BigInteger.Parse('37774242535411291684276865538926205024910326572967'),
BigInteger.Parse('23701913275725675285653248258265463092207058596522'),
BigInteger.Parse('29798860272258331913126375147341994889534765745501'),
BigInteger.Parse('18495701454879288984856827726077713721403798879715'),
BigInteger.Parse('38298203783031473527721580348144513491373226651381'),
BigInteger.Parse('34829543829199918180278916522431027392251122869539'),
BigInteger.Parse('40957953066405232632538044100059654939159879593635'),
BigInteger.Parse('29746152185502371307642255121183693803580388584903'),
BigInteger.Parse('41698116222072977186158236678424689157993532961922'),
BigInteger.Parse('62467957194401269043877107275048102390895523597457'),
BigInteger.Parse('23189706772547915061505504953922979530901129967519'),
BigInteger.Parse('86188088225875314529584099251203829009407770775672'),
BigInteger.Parse('11306739708304724483816533873502340845647058077308'),
BigInteger.Parse('82959174767140363198008187129011875491310547126581'),
BigInteger.Parse('97623331044818386269515456334926366572897563400500'),
BigInteger.Parse('42846280183517070527831839425882145521227251250327'),
BigInteger.Parse('55121603546981200581762165212827652751691296897789'),
BigInteger.Parse('32238195734329339946437501907836945765883352399886'),
BigInteger.Parse('75506164965184775180738168837861091527357929701337'),
BigInteger.Parse('62177842752192623401942399639168044983993173312731'),
BigInteger.Parse('32924185707147349566916674687634660915035914677504'),
BigInteger.Parse('99518671430235219628894890102423325116913619626622'),
BigInteger.Parse('73267460800591547471830798392868535206946944540724'),
BigInteger.Parse('76841822524674417161514036427982273348055556214818'),
BigInteger.Parse('97142617910342598647204516893989422179826088076852'),
BigInteger.Parse('87783646182799346313767754307809363333018982642090'),
BigInteger.Parse('10848802521674670883215120185883543223812876952786'),
BigInteger.Parse('71329612474782464538636993009049310363619763878039'),
BigInteger.Parse('62184073572399794223406235393808339651327408011116'),
BigInteger.Parse('66627891981488087797941876876144230030984490851411'),
BigInteger.Parse('60661826293682836764744779239180335110989069790714'),
BigInteger.Parse('85786944089552990653640447425576083659976645795096'),
BigInteger.Parse('66024396409905389607120198219976047599490197230297'),
BigInteger.Parse('64913982680032973156037120041377903785566085089252'),
BigInteger.Parse('16730939319872750275468906903707539413042652315011'),
BigInteger.Parse('94809377245048795150954100921645863754710598436791'),
BigInteger.Parse('78639167021187492431995700641917969777599028300699'),
BigInteger.Parse('15368713711936614952811305876380278410754449733078'),
BigInteger.Parse('40789923115535562561142322423255033685442488917353'),
BigInteger.Parse('44889911501440648020369068063960672322193204149535'),
BigInteger.Parse('41503128880339536053299340368006977710650566631954'),
BigInteger.Parse('81234880673210146739058568557934581403627822703280'),
98

BigInteger.Parse('82616570773948327592232845941706525094512325230608'),
BigInteger.Parse('22918802058777319719839450180888072429661980811197'),
BigInteger.Parse('77158542502016545090413245809786882778948721859617'),
BigInteger.Parse('72107838435069186155435662884062257473692284509516'),
BigInteger.Parse('20849603980134001723930671666823555245252804609722'),
BigInteger.Parse('53503534226472524250874054075591789781264330331690')
|;

Собственно решение задачи занимает всего несколько строк в процедуре
Solve:
// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
// находим сумму всех чисел:
var sum := numbers.Sum;

Для выделения первых 10 цифр мы переводим число в строку, вырезаем из
неё 10 цифр, а затем снова конвертируем в число:
var res := Convert.ToInt64(sum.ToString().Substring(0, 10));
Writeln($' Первые 10 цифр суммы чисел: {res}');
Writeln;
end;

begin
Writeln(' Project Euler. Problem 13');
Writeln;
Solve();
end.

А вот и ответ подоспел:
Project Euler. Problem 13
99

Первые 10 цифр суммы чисел: 5537376230

Вы вполне можете избежать строковых операций, чтобы
решение было абсолютно «чистым».

Проект Эйлер014
Исходный код программы находится в файле Эйлер014.pas.

Задача 14 (Problem 14) Longest Collatz sequence была опубликована 5 апреля 2002 года.
Условие задачи на английском языке:
The following iterative sequence is defined for the set of positive integers:
n → n/2 (n is even)
n → 3n + 1 (n is odd)
Using the rule above and starting with 13, we generate the following sequence:
13 → 40 → 20 → 10 → 5 → 16 → 8 → 4 → 2 → 1
It can be seen that this sequence (starting at 13 and finishing at 1) contains 10
terms. Although it has not been proved yet (Collatz Problem), it is thought that all
starting numbers finish at 1.
Which starting number, under one million, produces the longest chain?
NOTE: Once the chain starts the terms are allowed to go above one million.
Самая длинная последовательность Коллатца
100

Следующая последовательность определена для натуральных чисел:
n → n/2 (n - чётное)
n → 3n + 1 (n - нечётное)
Используя описанное выше правило и начиная с 13, вы можете сгенерировать такую последовательность:
13 → 40 → 20 → 10 → 5 → 16 → 8 → 4 → 2 → 1
Получившаяся последовательность 13 . . . 1 содержит 10 элементов. Хотя
это до сих пор и не доказано (проблема Коллатца (Collatz)), предполагается,
что все сгенерированные таким образом последовательности заканчиваются 1.
Какой начальный элемент меньше миллиона генерирует самую длинную последовательность?
Примечание: члены последовательности могут иметь значения больше
миллиона.
Самое главное в этой задаче – учесть замечание в конце её условия и правильно выбрать структуру данных для хранения членов последовательности. Опыт показывает, что вполне достаточно чисел типа int64.
Других препятствий в решении задачи методом грубой силы мы не встретим:
uses MathExtensions;

// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
// число, начинающее последовательность:
var startNum: int64 := 0;
// макс. длина последовательности:
var maxLen := 0;
101

// макс. число в последовательности:
var maxNum: int64 := 0;
for var num := 1 to 1000000 do begin
var n: int64 := num;
var length := 1;
while (n <> 1) do begin
if (n mod 2 = 0) then n := n div 2
else n := 3 * n + 1;
if (n > maxNum) then maxNum := n;
length += 1;
end;
// запоминаем самую длинную последовательность:
if (length > maxLen) then begin
startNum := num;
maxLen := length;
end;
end;
Writeln($' Самая длинная последовательность начинается с:
{startNum}');
Writeln($' Её длина = {maxLen}');
Writeln;
Writeln($' Самое большое число в последовательностях = {maxNum}');
Writeln;
end;

begin
Writeln(' Project Euler. Problem 14');
Writeln;
Solve();
end.

Полный и развёрнутый ответ на задачу тут:
Project Euler. Problem 14
Самая длинная последовательность начинается с: 837799
Её длина = 525
102

Самое большое число в последовательностях = 56991483520

В сборнике головоломок Über 500 Brain Games: Denkspiele aus Wissenschaft,
Natur und Technik в задаче номер 533 Zahlenhagel мы снова встречаемся с
последовательностью Коллатца:
Denken Sie an eine Zahl. Wenn sie ungerade ist, nehmen Sie sie mal drei und addieren Sie 1; wenn sie gerade ist, teilen Sie sie durch 2. Mit jeder Zahl, die Sie in der
Folge erhalten, verfahren Sie ebenso.
Mit 1 beginnend, erhalten Sie: 1,4,2,1,4,2,1,4,2 etc.
Mit 2 beginnend, erhalten Sie: 2,1,4,2,1,4,2,1,4 etc.
Mit 3 beginnend, erhalten Sie: 3,10,5,16,8,4,2,1,4,2,1 etc.
Bald werden Sie merken, dass sie Sequenz in einer Endlosschlufe von 1-4-2-1-4-2
hängen bleibt. Ist das wirklich bei jeder Sequenz der Fall? Versuchen Sie mal mit der
7 zu beginnen.
Таким образом, наша задача состоит в том, чтобы вручную составить последовательность Коллатца, начинающуюся с 7.
Поскольку у нас есть компьютер, то пусть он и считает. А нам нужно написать перегрузку процедуры Solve - с параметром, который и обозначает
начало последовательности:
procedure Solve(start: int64);
begin
// число, начинающее последовательность:
var startNum := start;
// макс. число в последовательности:
var maxNum: int64 := 0;
var n := startNum;
// длина последовательности:
var length := 1;
while (n <> 1) do begin
Write(' ' + n + ' ');
if (n mod 2 = 0) then n := n div 2
else n := 3 * n + 1;
103

if (n > maxNum) then maxNum := n;
length += 1;
end;
Writeln;
Writeln($' Длина последовательности = {length}');
Writeln;
Writeln($' Самое большое число в последовательностях = {maxNum}');
Writeln;
end;

В книге приводится этот же ответ:
Project Euler. Problem 14
7 22 11 34 17 52 26 13
Длина последовательности = 17

40

20

10

5

16

8

4

2

Самое большое число в последовательностях = 52

Немцы называют эту задачу Hagelkörnerproblem, усматривая в бесконечном цикле чисел 1-4-2-1-4-2 Hagelkörner – градины - в грозовом облаке.
Также в ответе приводится информация об интересной последовательности, начинающейся с числа 27. Она довольно длинная, но при большом желании вы можете все выкладки арифметические провести вручную. Для
проверки вашей точности и бдительности привожу точное компьютерное
решение:
begin
Writeln(' Project Euler. Problem 14');
Writeln;
//Solve();
//Solve(7);
Solve(27);
end.

104

Project Euler. Problem 14
27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242
121 364 182 91 274 137 412 206 103 310 155 466 233 700 350
175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167
502 251 754 377 1132 566 283 850 425 1276 638 319 958 479
1438 719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911
2734 1367 4102 2051 6154 3077 9232 4616 2308 1154 577 1732
866 433 1300 650 325 976 488 244 122 61 184 92 46 23 70 35
106 53 160 80 40 20 10 5 16 8 4 2
Длина последовательности = 112
Самое большое число в последовательностях = 9232

Проект Эйлер015
Исходный код программы находится в файле Эйлер015.pas.

Задача 15 (Problem 15) Routes through a 20×20 grid была опубликована 19
апреля 2002 года.
Условие задачи на английском языке:
Starting in the top left corner of a 2×2 grid, there are 6 routes (without backtracking) to the bottom right corner.

How many routes are there through a 20×20 grid?
105

Пути в сетке 20 х 20
В сетке 2×2 можно проложить 6 маршрутов (двигаясь только вниз или
вправо), начинающихся в левом верхнем углу и заканчивающихся в правом
нижнем.
Сколько существует маршрутов в сетке 20×20?
Можно предположить, что число путей будет очень большим. Это значит,
что в обнимку с методом грубой силы мы будем бродить по сетке дольше,
чем Моисей по пустыне.
Впрочем, в задаче нетрудно разглядеть основания для применения метода
динамического программирования.
Как обычно, мы сначала рассмотрим минимальную сетку, состоящую из
одной клетки. Она имеет 2 вершины по горизонтали и столько же по вертикали.
В начале пути мы занимаем позицию в верхней левой вершине. Так как все
пути начинаются в этой вершине, то нет ни одного пути, ведущего к ней.
Поэтому мы ставим в эту вершину нулик. Число путей в остальные вершины нам пока неизвестно. Такие вершины мы помечаем крестиком (или
иксиком):

Двигаясь из начальной вершины строго вправо или вниз, мы окажемся в
правой верхней вершине или в левой нижней. Таким образом, существует
ровно 1 путь из начальной вершины в каждую из этих вершин:
106

Из этих вершин также существует по 1 пути в последнюю вершину. Итого
мы получаем 2 пути для одноклеточной сетки:

Расширим сетку до размеров 3 х 3 клетки и проставим число путей, которые
ведут в уже известные нам вершины:

107

Из вершин с единицей имеется единственный новый путь – вправо и вниз:

Легко видеть, что в любую вершину, лежащую на верхней или на левой стороне сетки, можно добраться единственным путём, иначе нам пришлось
бы идти вспять, что запрещено условиями задачи:

В вершины, отмеченные на рисунке⬆ красными крестиками, можно попасть из единичных вершин на сторонах сетки или из вершины с двойкой.
108

Но в вершины с 1 можно попасть единственным путём, а в вершину с 2 –
двумя. Итого в каждую из вершин с красным крестиком можно добраться
тремя разными путями:

Во вторую вершину на нижней стороне сетки можно попасть из угловой
вершины с единицей или из верхней с тройкой. Учитывая число путей в эти
вершины, мы получаем 4 пути для рассматриваемой вершины:

109

Рассуждая аналогично, мы должны прийти к выводу, что общее число путей
в заданную вершину равно сумме числа путей соседних с ней вершин –
слева и сверху:

Если положить нашу сетку на бочок, то легко заметить, что число путей в
ней образует треугольник Паскаля.
Правда, в начальной вершине сетки стоит не 1, а 0, но мы легко можем представить себе, что имеется и путь в начальную вершину из какой-нибудь
весьма удалённой точки.
В свою очередь, треугольник Паскаля состоит из биномиальных коэффициентов. А биномиальные коэффициенты равны числу подмножеств для
множеств с соответствующим числом элементов.
Вот теперь можно решать задачу!

110

В процедуре Solve мы должны учесть, что число вершин по обеим размерностям сетки на 1 больше числа клеток.
Чтобы избежать краевых эффектов, мы загодя проставляем 1 по левой и
верхней сторонам сетки – теперь все внутренние вершины имеют ровно
двух соседей сверху и слева:
uses MathExtensions;

// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
// сетка:
var size := 20;
var grid := new int64[size + 1, size + 1];
// число путей из вершин,
// лежащих на верхней и левой сторонах сетки:
111

for var i := 1 to size do begin
grid[i, 0] := 1;
grid[0, i] := 1;
end;
for var row := 1 to size do
for var col := 1 to size do
grid[col, row] := grid[col - 1, row] + grid[col, row - 1];

После подсчёта путей для каждой вершины нам нужно прочитать число, получившееся в правой нижней вершине:
Writeln($' Число путей в сетке = {grid[size, size]}');
Writeln;
end;

begin
Writeln(' Project Euler. Problem 15');
Writeln;
Solve();
end.

Оно служит ответом на задачу:
Project Euler. Problem 15
Число путей в сетке = 137846528820

Проект Эйлер016
Исходный код программы находится в файле Эйлер016.pas.

112

Задача 16 (Problem 16) Power digit sum была опубликована 3 мая 2002 года.
Условие задачи на английском языке:
215 = 32768 and the sum of its digits is 3 + 2 + 7 + 6 + 8 = 26.
What is the sum of the digits of the number 21000?
Сумма цифр
215 = 32768, сумма цифр 3 + 2 + 7 + 6 + 8 = 26.
Чему равна сумма цифр числа 21000?
Так как число 21000 очень большое, то для его хранения потребуется переменная типа BigInteger, а для нахождения суммы цифр таких чисел мы пишем новую функцию для модуля MathExtensions:
// ВОЗВРАЩАЕТ СУММУ ЦИФР ЗАДАННОГО ЧИСЛА типа BigInteger
function Summa(num: BigInteger): int64;
begin
var sum := BigInteger(0);
while (num > 0) do begin
sum += num mod 10;
num := num div 10;
end;
Result := int64(sum);
end;

В процедуре Solve возводим двойку в тысячную степень и с помощью новой
функции находим сумму его цифр:
uses MathExtensions;

// РЕШАЕМ ЗАДАЧУ
procedure Solve();
113

begin
var pow := BigInteger.Pow(2, 1000);
Writeln($' 2 ^ 1000 = {pow}');
var sum := Summa(pow);
Writeln($' Сумма цифр = {sum}');
Writeln;
end;

begin
Writeln(' Project Euler. Problem 16');
Writeln;
Solve();
end.

В отличие от самого числа сумма его цифр совсем невелика!
Project Euler. Problem 16
2 ^ 1000 =
1071508607186267320948425049060001810561404811705533607443750388370351051
1249361224931983788156958581275946729175531468251871452856923140435984577
5746985748039345677748242309854210746050623711418779541821530464749835819
4126739876755916554394607706291457119647768654216766042983165262438683720
5668069376
Сумма цифр = 1366

Проект Эйлер017
Исходный код программы находится в файле Эйлер017.pas.

114

Задача 17 (Problem 17) Number letter counts была опубликована 17 мая
2002 года.
Условие задачи на английском языке:
If the numbers 1 to 5 are written out in words: one, two, three, four, five, then there
are 3 + 3 + 5 + 4 + 4 = 19 letters used in total.
If all the numbers from 1 to 1000 (one thousand) inclusive were written out in
words, how many letters would be used?
NOTE: Do not count spaces or hyphens. For example, 342 (three hundred and fortytwo) contains 23 letters and 115 (one hundred and fifteen) contains 20 letters. The
use of "and" when writing out numbers is in compliance with British usage.
Число букв в числительных
Если записать числа от 1 до 5 английскими словами (one, two, three, four,
five), то используется 3 + 3 + 5 + 4 + 4 = 19 букв.
Сколько букв понадобится для записи всех чисел от 1 до 1000 (one
thousand) включительно?
Примечание: Не считайте пробелы и дефисы. Например, число 342 (three
hundred and forty-two) состоит из 23 букв, число 115 (one hundred and fifteen)
- из 20 букв. Использование "and" при записи чисел соответствует правилам
британского английского языка.
В процедуре Solve мы превращаем все числа в заданном диапазоне 1..1000
в слова, которые затем разбиваем на символы, и добавляем к результату
только буквы:
uses MathExtensions;
const
OneThousand = 1000;
OneMillion = 1000000;
OneBillion = 1000000000;
115

var words := new Dictionary<int64, string>;
procedure CreateDict();
begin
words.Add(0, 'zero');
words.Add(1, 'one');
words.Add(2, 'two');
words.Add(3, 'three');
words.Add(4, 'four');
words.Add(5, 'five');
words.Add(6, 'six');
words.Add(7, 'seven');
words.Add(8, 'eight');
words.Add(9, 'nine');
words.Add(10, 'ten');
words.Add(11, 'eleven');
words.Add(12, 'twelve');
words.Add(13, 'thirteen');
words.Add(14, 'fourteen');
words.Add(15, 'fifteen');
words.Add(16, 'sixteen');
words.Add(17, 'seventeen');
words.Add(18, 'eighteen');
words.Add(19, 'nineteen');
words.Add(20, 'twenty');
words.Add(30, 'thirty');
words.Add(40, 'forty');
words.Add(50, 'fifty');
words.Add(60, 'sixty');
words.Add(70, 'seventy');
words.Add(80, 'eighty');
words.Add(90, 'ninety');
words.Add(100, 'hundred');
words.Add(1000, 'thousand');
words.Add(1000000, 'million');
words.Add(1000000000, 'billion');
end;
function NumberToWords(number: int64): string;
begin
if number < 0 then
Result := 'negative ' + NumberToWords(-number)
else if number < 20 then
Result := words[number]
else if number < 100 then
116

begin
var tens := (number div 10) * 10;
var units := number mod 10;
Result := words[tens];
if units > 0 then
Result := Result + '-' + words[units];
end
else if number < 1000 then
begin
var hundreds := number div 100;
var remainder := number mod 100;
Result := words[hundreds] + ' hundred';
if remainder > 0 then
Result := Result + ' and ' + NumberToWords(remainder);
end
else if number < 1000000 then
begin
var thousands := number div 1000;
var remainder := number mod 1000;
Result := NumberToWords(thousands) + ' thousand';
if remainder > 0 then
begin
if remainder < 100 then
Result := Result + ' and ' + NumberToWords(remainder)
else
Result := Result + ', ' + NumberToWords(remainder);
end;
end
else if number < 1000000000 then
begin
var millions := number div 1000000;
var remainder := number mod 1000000;
Result := NumberToWords(millions) + ' million';
if remainder > 0 then
Result := Result + ', ' + NumberToWords(remainder);
end
else
begin
var billions := number div 1000000000;
var remainder := number mod 1000000000;
Result := NumberToWords(billions) + ' billion';
if remainder > 0 then
Result := Result + ', ' + NumberToWords(remainder);
end;
end;
117

// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
CreateDict;
var totalLetters := 0;
for var i := 1 to 1000 do begin
var words := NumberToWords(i)
.Replace(' ', '')
.Replace('-', '')
.Replace(',', '');
totalLetters += words.Length;
end;
Writeln($' Всего букв в числах 1-1000: {totalLetters}');
Writeln;
end;

begin
Writeln(' Project Euler. Problem 17');
Writeln;
Solve();
end.

Задача решена быстро и аккуратно:
Project Euler. Problem 17
Всего букв в числах 1-1000: 21124

При желании или без оного вы можете урешать этого Эйлера по-русски:
uses MathExtensions;
const
Тысяча = 1000;
Миллион = 1000000;
Миллиард = 1000000000;
118

var слова := new Dictionary<int64, string>;
procedure CreateDict();
begin
слова.Add(0, 'ноль');
слова.Add(1, 'один');
слова.Add(2, 'два');
слова.Add(3, 'три');
слова.Add(4, 'четыре');
слова.Add(5, 'пять');
слова.Add(6, 'шесть');
слова.Add(7, 'семь');
слова.Add(8, 'восемь');
слова.Add(9, 'девять');
слова.Add(10, 'десять');
слова.Add(11, 'одиннадцать');
слова.Add(12, 'двенадцать');
слова.Add(13, 'тринадцать');
слова.Add(14, 'четырнадцать');
слова.Add(15, 'пятнадцать');
слова.Add(16, 'шестнадцать');
слова.Add(17, 'семнадцать');
слова.Add(18, 'восемнадцать');
слова.Add(19, 'девятнадцать');
слова.Add(20, 'двадцать');
слова.Add(30, 'тридцать');
слова.Add(40, 'сорок');
слова.Add(50, 'пятьдесят');
слова.Add(60, 'шестьдесят');
слова.Add(70, 'семьдесят');
слова.Add(80, 'восемьдесят');
слова.Add(90, 'девяносто');
слова.Add(100, 'сто');
слова.Add(200, 'двести');
слова.Add(300, 'триста');
слова.Add(400, 'четыреста');
слова.Add(500, 'пятьсот');
слова.Add(600, 'шестьсот');
слова.Add(700, 'семьсот');
слова.Add(800, 'восемьсот');
слова.Add(900, 'девятьсот');
слова.Add(1000, 'тысяча');
слова.Add(1000000, 'миллион');
слова.Add(1000000000, 'миллиард');
end;
119

function NumberToRussianWords(number: int64): string;
begin
if number < 0 then
Result := 'минус ' + NumberToRussianWords(-number)
else if number < 20 then
Result := слова[number]
else if number < 100 then
begin
var десятки := (number div 10) * 10;
var единицы := number mod 10;
Result := слова[десятки];
if единицы > 0 then
Result := Result + ' ' + слова[единицы];
end
else if number < 1000 then
begin
var сотни := (number div 100) * 100;
var остаток := number mod 100;
Result := слова[сотни];
if остаток > 0 then
Result := Result + ' ' + NumberToRussianWords(остаток);
end
else if number < 1000000 then
begin
var тысячи := number div 1000;
var остаток := number mod 1000;
// Склонение тысяч
var тысСлово := 'тысяч';
if (тысячи mod 10 = 1) and (тысячи mod 100 <> 11) then
тысСлово := 'тысяча'
else if (тысячи mod 10 in [2..4]) and not (тысячи mod 100 in
[12..14]) then
тысСлово := 'тысячи';
Result := NumberToRussianWords(тысячи) + ' ' + тысСлово;
if остаток > 0 then
Result := Result + ' ' + NumberToRussianWords(остаток);
end
else
Result := 'очень большое число';
end;

// РЕШАЕМ ЗАДАЧУ
120

procedure Solve();
begin
CreateDict;
var totalLetters := 0;
for var i := 1 to 1000 do begin
var words := NumberToRussianWords(i)
.Replace(' ', '')
.Replace('-', '')
.Replace(',', '');
totalLetters += words.Length;
end;
Writeln($' Всего букв в числах 1-1000: {totalLetters}');
Writeln;
end;

begin
Writeln(' Project Euler. Problem 17rus');
Writeln;
Solve();
end.

Весьма странно и загадочно, но русские слова оказались короче:
Project Euler. Problem 17rus
Всего букв в числах 1-1000: 18040

Проект Эйлер018
Исходный код программы находится в файле Эйлер018.pas.

121

Задача 18 (Problem 18) Maximum path sum I была опубликована 31 мая
2002 года.
Условие задачи на английском языке:
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
74
246
8593
That is, 3 + 7 + 4 + 9 = 23.
Find the maximum total from top to bottom of the triangle below:
75
95 64
17 47 82
18 35 87 10
20 04 82 47 65
19 01 23 75 03 34
88 02 77 73 07 63 67
99 65 04 28 06 16 70 92
122

41 41 26 56 83 40 80 70 33
41 48 72 33 47 32 37 16 94 29
53 71 44 65 25 43 91 52 97 51 14
70 11 33 28 77 73 17 78 39 68 17 57
91 71 52 38 17 14 91 43 58 50 27 29 48
63 66 04 68 89 53 67 30 73 16 69 87 40 31
04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
NOTE: As there are only 16384 routes, it is possible to solve this problem by trying
every route. However, Problem 67, is the same challenge with a triangle containing
one-hundred rows; it cannot be solved by brute force, and requires a clever method!
;o)
Максимальная сумма пути 1
Начиная в вершине треугольника (см. пример ниже) и перемещаясь вниз на
смежные числа до основания, мы получим максимальную сумму 3 + 7 + 4 + 9
= 23.
3
74
246
8593
Найдите максимальную сумму пути от вершины до основания следующего треугольника:
75
95 64
17 47 82
18 35 87 10
20 04 82 47 65
19 01 23 75 03 34
88 02 77 73 07 63 67
99 65 04 28 06 16 70 92
41 41 26 56 83 40 80 70 33
41 48 72 33 47 32 37 16 94 29
53 71 44 65 25 43 91 52 97 51 14
70 11 33 28 77 73 17 78 39 68 17 57
91 71 52 38 17 14 91 43 58 50 27 29 48
63 66 04 68 89 53 67 30 73 16 69 87 40 31
123

04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
Примечание: Так как в данном треугольнике всего 16384 маршрута от вершины до основания, эту задачу можно решить, проверяя каждый из маршрутов. Однако похожая Задача 67 с треугольником, состоящим из сотни
строк, не решается перебором (brute force) и требует более умного подхода!
;o)
Числовой треугольник удобно представить в виде массива строк, в которых отдельные числа разделяет пробел:
uses MathExtensions;
// числовая пирамида:
var triangle :=
|'75',
'95 64',
'17 47 82',
'18 35 87 10',
'20 04 82 47 65',
'19 01 23 75 03 34',
'88 02 77 73 07 63 67',
'99 65 04 28 06 16 70 92',
'41 41 26 56 83 40 80 70 33',
'41 48 72 33 47 32 37 16 94 29',
'53 71 44 65 25 43 91 52 97 51 14',
'70 11 33 28 77 73 17 78 39 68 17 57',
'91 71 52 38 17 14 91 43 58 50 27 29 48',
'63 66 04 68 89 53 67 30 73 16 69 87 40 31',
'04 62 98 27 23 09 70 98 73 93 38 53 60 04 23'|;

В процедуре Solve мы последовательно получаем из этого массива строки,
разбиваем их на отдельные слова – строковые представления чисел, конвертируем слова в числа и помещаем их во временный список чисел очередной строки lst. И наконец, всю строку чисел в этом списке мы добавляем к
списку строк rows:
// РЕШАЕМ ЗАДАЧУ
procedure Solve();
124

begin
// построчный список чисел:
var rows := new List<List<int>>();
foreach var s in triangle do begin
// разбиваем строку на отдельные "слова":
var wrd := s.Split(' ');
var lst := new List<int>();
foreach var w in wrd do begin
var num := int.Parse(w);
lst.Add(num);
end;
rows.Add(lst);
end;

Теперь все числа из треугольника получили прописку в списке rows, из которого извлекать отдельные числа просто и удобно.
Эта задача опять легко решается методом динамического программирования.
Пусть мы имеем минимальный треугольник:
2
85
Максимальная сумма пути в нём равна:
Max(8+2, 5+2) = 10
Увеличим высоту треугольника на 1 строку:
7
24
859
Мы уже знаем, что из двойки нужно пойти влево вниз, чтобы получить максимальную сумму 10. Аналогично для четвёрки: нужно пойти к девятке,
чтобы получить максимальную из возможных сумм:
Max(4+5, 4+9) = 13
Итак, двигаясь из семёрки, мы можем получить суммы:
125

10 13
Максимальная сумма всего пути равна:
Max(7+10, 7+13) = 20
Добавим ещё одну строку и получим треугольник из условия задачи:
3
74
246
8593
С учётом наших предварительных изысканий его можно переписать так:
3
74
10 13 15
Как мы выяснили, максимальная сумма пути из семёрки равна 20, а из четвёрки:
Max(4+13, 4+15) = 19
Тогда максимальная сумма пути из тройки:
3
20 19
равна:
Max(3+20, 3+19) = 23
Наглядно процесс прокладки максимального пути показан на рисунке↓.
Так как числа в основании треугольника являются конечными, то давайте
стартуем с последнего шага, который должен начаться с чисел 2, 4 или 6.
Если мы пойдём от двойки влево, то добавим к сумме пути 10, а если
вправо, то только 7. Вывод: от двойки нужно идти к восьмёрке.
126

Если путь оказался в четвёрке, то выгоднее идти вправо, добавляя к сумме
13.
Если путь оказался в шестёрке, то выгоднее идти влево, добавляя к сумме
15.
Поднимемся на один этаж выше.
Если путь оказался в семёрке, то выгоднее пойти вправо, добавляя к сумме
20. Если же путь оказался в четвёрке, то также выгоднее идти вправо, добавляя к сумме 19.
И вот мы оказались на вершине треугольника, с тройкой. Если мы пойдём
налево, то сумма чисел пути составит 23, а если направо, то 22. Ответ получен, и мы избежали утомительного перебора вариантов!
Итак, решая задачу, мы должны двигаться от основания треугольника к его
вершине. Для каждого числа в верхней строке мы находим максимальное из
двух чисел строкой ниже и заменяем верхнее число его суммой с этим числом.
В итоге мы найдём максимальную сумму пути из самого верхнего числа, которая и есть ответ на задачу:
// макс. сумма:
var maxs := 0;
// число строк в треугольнике:
127

var nRows := rows.Count();
// список текущих макс. значений сумм:
var maxValues := new int[nRows];
// макс. значения сумм в последней строке =
// числам в этой строке:
for var i := 0 to nRows-1 do
maxValues[i] := rows[nRows - 1][i];
for var r := nRows - 2 downto 0 do
for var c := 0 to r do begin
maxValues[c] := rows[r][c] +
Max(maxValues[c], maxValues[c + 1]);
end;
maxs := maxValues[0];
Writeln($' Максимальная сумма = {maxs}');
Writeln;
end;

begin
Writeln(' Project Euler. Problem 18');
Writeln;
Solve();
end.

Project Euler. Problem 18
Максимальная сумма = 1074

Проект Эйлер067
Исходный код программы находится в файле Эйлер067.pas.

128

Решение этой задачи методом динамического программирования ничем
не отличается от решения задачи №18.
Задача 67 (Problem 67) Maximum path sum II была опубликована 9 апреля
2004 года.
Условие задачи на английском языке:
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
74
246
8593
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 299 altogether! If you could check
one trillion (1012) routes every second it would take over twenty billion years to
check them all. There is an efficient algorithm to solve it. ;o)
Максимальная сумма пути 2
Начиная в вершине треугольника (см. пример ниже) и перемещаясь вниз на
смежные числа до основания, мы получим максимальную сумму 3 + 7 + 4 + 9
= 23.
3
74
246
8593
Найдите максимальную сумму при переходе от вершины до основания
треугольника, представленного текстовым файлом размером 15КБ
triangle.txt), в котором содержится треугольник с одной сотней строк.
129

ПРИМЕЧАНИЕ: Это намного усложненная версия 18-й задачи. Данную задачу
нельзя решить, испробовав каждый возможный вариант, поскольку всего их
299! Если бы удалось проверять один триллион (1012) вариантов в секунду,
то потребовалось бы двадцать биллионов лет чтобы испробовать их все.
Существует эффективный алгоритм решения данной задачи. ;o)
Так как теперь числовой треугольник хранится в текстовом файле, то мы
загружаем его в строковый массив triangle с диска, а весь остальной код метода Solve остаётся без изменений:
uses MathExtensions;
// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
var path := 'p067_triangle.txt';
var triangle := ReadAllLines(path);
// построчный список чисел:
var rows := new List<List<int>>();
foreach var s in triangle do begin
// разбиваем строку на отдельные "слова":
var wrd := s.Split(' ');
var lst := new List<int>();
foreach var w in wrd do begin
var num := int.Parse(w);
lst.Add(num);
end;
rows.Add(lst);
end;
// макс. сумма:
var maxs := 0;
// число строк в треугольнике:
var nRows := rows.Count();
// список текущих макс. значений сумм:
var maxValues := new int[nRows];
// макс. значения сумм в последней строке =
// числам в этой строке:
for var i := 0 to nRows-1 do
130

maxValues[i] := rows[nRows - 1][i];
for var r := nRows - 2 downto 0 do
for var c := 0 to r do begin
maxValues[c] := rows[r][c] +
Max(maxValues[c], maxValues[c + 1]);
end;
maxs := maxValues[0];
Writeln($' Максимальная сумма = {maxs}');
Writeln;
end;

begin
Writeln(' Project Euler. Problem 67');
Writeln;
Solve();
end.

Вместо биллионов лет (по-русски говоря, миллиардов), которыми нас пугали составители задачи, компьютеру потребовались доли секунды, чтобы
решить задачу:
Project Euler. Problem 67
Максимальная сумма = 7273

Алгоритмы – это сила!

Проект Эйлер019
Исходный код программы находится в файле Эйлер019.pas.

131

Задача 19 (Problem 19) Counting Sundays была опубликована 14 июня 2004
года.
Условие задачи на английском языке:
You are given the following information, but you may prefer to do some research for
yourself.
• 1 Jan 1900 was a Monday.
• Thirty days has September,
April, June and November.
All the rest have thirty-one,
Saving February alone,
Which has twenty-eight, rain or shine.
And on leap years, twenty-nine.
• A leap year occurs on any year evenly divisible by 4, but not on a century unless it
is divisible by 400.
How many Sundays fell on the first of the month during the twentieth century (1 Jan
1901 to 31 Dec 2000)?
Считаем воскресенья
Дана следующая информация (однако, вы можете проверить её самостоятельно):
•
•
•

1 января 1900 года - понедельник.
В сентябре, апреле, июне и ноябре 30 дней.
В феврале 28, в високосный год - 29.
В остальных месяцах по 31 дню.
Високосный год - любой год, делящийся нацело на 4, однако первый год
века является високосным только том случае, если делится на 400.

Сколько воскресений выпадает на первое число месяца в двадцатом
веке (с 1 января 1901 года по 31 декабря 2000 года)?
Самая сложная закавыка в этой задаче – определить день недели по дате –
легко решается с помощью свойства DayOfWeek структуры DateTime:
132

uses MathExtensions, System;
// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
var count := 0;
for var year := 1901 to 2000 do
for var month := 1 to 12 do begin
// создаём дату - первое число месяца:
var dt := new DateTime(year, month, 1);
// проверяем на воскресенье:
if dt.DayOfWeek = DayOfWeek.Sunday then
count += 1;
end;
Writeln($' Число воскресений = {count}');
Writeln;
end;

begin
Writeln(' Project Euler. Problem 19');
Writeln;
Solve();
end.

Итак, в 20 веке 171 раз месяц начинался с воскресенья:
Project Euler. Problem 19
Число воскресений = 171

Вот решение задачи для любителей однострочников, подстрочников и
криптографии:
procedure Solve2();
begin
var count := Range(1901, 2000)
.SelectMany(year -> Range(1, 12)
133

.Select(month -> new DateTime(year, month, 1)))
.Count(dt -> dt.DayOfWeek = DayOfWeek.Sunday);
Writeln($' Число воскресений = {count}');
Writeln;
end;

Решение задачи для любителей функционального программирования:
function GetSundayFirsts(startYear, endYear: integer): sequence of
DateTime;
begin
for var year := startYear to endYear do
for var month := 1 to 12 do begin
var dt := new DateTime(year, month, 1);
if dt.DayOfWeek = DayOfWeek.Sunday then
yield dt;
end;
end;
procedure Solve3();
begin
var sundays := GetSundayFirsts(1901, 2000).ToArray;
Writeln($' Число воскресений = {sundays.Length}');
Writeln;
end;

Для интереса любознательности вы можете распечатать все воскресенья
20-го века, с которых начинается месяц:
procedure Solve3();
begin
var sundays := GetSundayFirsts(1901, 2000).ToArray;
Writeln($' Число воскресений = {sundays.Length}');
Writeln;
for var i := 0 to sundays.Length - 1 do
Writeln(' ', sundays[i].ToString('dd.MM.yyyy'));
end;

134

01.09.1901
01.12.1901
01.06.1902
01.02.1903
01.03.1903
01.11.1903
01.05.1904
01.01.1905
. . .
01.02.1998
01.03.1998
01.11.1998
01.08.1999
01.10.2000

Поскольку мы использовали специфические возможности паскаля, то давайте решим задачу по-честному:
function IsSunday(year, month, day: int): bool;
begin
// Алгоритм Зеллера для определения дня недели
// Возвращает 0=суббота, 1=воскресенье, ..., 6=пятница
if month < 3 then begin
month := month + 12;
year := year - 1;
end;
var K := year mod 100;
var J := year div 100;
var h := (day + ((13 * (month + 1)) div 5) +
K + (K div 4) + (J div 4) +
5 * J) mod 7;
// h = 1 - воскресенье:
Result := h = 1;
end;
procedure Solve4;
begin
var count := 0;
135

for var year := 1901 to 2000 do
for var month := 1 to 12 do
if IsSunday(year, month, 1) then
count += 1;
Writeln($' Число воскресений = {count}');
Writeln;
end;

Проект Эйлер020
Исходный код программы находится в файле Эйлер020.pas.

Задача 20 (Problem 20) Factorial digit sum была опубликована 21 июня
2004 года.
Условие задачи на английском языке:
n! means n × (n − 1) × ... × 3 × 2 × 1
For example, 10! = 10 × 9 × ... × 3 × 2 × 1 = 3628800,
and the sum of the digits in the number 10! is 3 + 6 + 2 + 8 + 8 + 0 + 0 = 27.
Find the sum of the digits in the number 100!
Сумма цифр факториала
n! означает n × (n − 1) × ... × 3 × 2 × 1
Найдите сумму цифр в числе 100!
Добавляем в модуль BigIntegerExtensions новый метод расширения:
/// ВОЗВРАЩАЕТ ФАКТОРИАЛ ЗАДАННОГО ЧИСЛА
136

function FactorialBig(self: Integer): BigInteger; extensionmethod;
begin
if self < 0 then
raise new System.ArgumentOutOfRangeException('Factorial is not defined for negative numbers');
if self = 0 then exit(1);
Result := 1;
var i := BigInteger(1);
while i <= self do begin
Result := Result * i;
i := i + 1;
end;
end;

И решаем задачу в одно действие:
uses BigIntegerExtensions;
// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
var sum := 100.FactorialBig.DigitSumBig;
Writeln($' Сумма цифр факториала = {sum}');
Writeln;
end;

begin
Writeln(' Project Euler. Problem 20');
Writeln;
Solve();
end.

Сумму цифр длинных чисел мы уже научились подсчитывать, так что задача решена!
137

Project Euler. Problem 20
Сумма цифр факториала = 648

Проект Эйлер021
Исходный код программы находится в файле Эйлер021.pas.

Задача 21 (Problem 21) называется Amicable Numbers.

Дружественные числа
Пусть d(n) определяется как сумма делителей n (числа меньше n, делящие n
нацело).
Если d(a) = b и d(b) = a, где a ≠ b, то a и b называются дружественной парой,
а каждое из чисел a и b - дружественным числом.
Например, делителями числа 220 являются 1, 2, 4, 5, 10, 11, 20, 22, 44, 55 и 110,
поэтому d(220) = 284. Делители 284 - 1, 2, 4, 71, 142, поэтому d(284) = 220.
Подсчитайте сумму всех дружественных чисел меньше 10000.
Два (различных) натуральных числа называются дружественными, если
сумма всех делителей (исключая само число) первого числа равна второму
138

числу, и наоборот. Первая пара дружественных чисел была найдена несколько тысячелетий тому назад. Это числа 220 и 284. Следующая пара
отыскалась только в 1866 году – 1184 и 1210 (но раньше уже были известны другие дружественные числа). Сейчас список дружественных чисел
включает миллиарды пар. Оба числа в паре либо оба чётные, либо оба нечётные.
Как обычно и принято, пусть задачу решает процедура Solve:
begin
Writeln(' Project Euler. Problem 21');
Writeln;
Solve();
end.

Но ей не обойтись без функции SumOfDivisors, которая возвращает сумму
делителей заданного числа:
uses MathExtensions;
function SumOfDivisors(n: int): int;
begin
if n < 2 then exit(0);
// 1 всегда делитель:
var sum := 1;
var limit := ISqrt(n);
for var i := 2 to limit do begin
if n mod i = 0 then begin
sum += i;
var complement := n div i;
if complement <> i then
sum := sum + complement;
end;
end;
Result := sum;
end;
139

А теперь во всю прыть решаем задачу:
const limit = 10000;
// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin
var totalSum := 0;

Для простоты и уменьшения перебора запишем суммы всех чисел для указанного диапазона в массив divisorSums:
// вычисляем суммы делителей для всех чисел:
var divisorSums : array[0..limit + 1] of int;
for var a := 2 to limit do
divisorSums[a] := SumOfDivisors(a);

Все суммы загнаны в массив. Теперь мы можем подыскать большого
дружка для каждого меньшего числа. Вынимаем из массива сумму делителей
числа а и проверяем, есть ли в массиве сумма делителей для числа b, которая равна числу а. Если таковая найдётся, то оба числа подружатся:
// дружественные пары:
Writeln($' Дружественные числа до {limit}:');
Writeln(' -----------------------------');
for var a := 2 to limit do begin
var b := divisorSums[a];
if (b > a) and (b <= limit) then begin
if divisorSums[b] = a then begin
Writeln($' {a} и {b}');
totalSum += a + b;
end;
end;
end;
Writeln(' -----------------------------');
Writeln($' Сумма: {totalSum}');
end;
140

Дружеская задача решена по-дружески:
Project Euler. Problem 21
Дружественные числа до 10000:
----------------------------220 и 284
1184 и 1210
2620 и 2924
5020 и 5564
6232 и 6368
----------------------------Сумма: 31626

Увеличив десятырежды значение константы limit,
const limit = 100000;

мы найдём и более крутые пары:
Project Euler. Problem 21
Дружественные числа до 100000:
----------------------------220 и 284
1184 и 1210
2620 и 2924
5020 и 5564
6232 и 6368
10744 и 10856
12285 и 14595
17296 и 18416
63020 и 76084
66928 и 66992
67095 и 71145
69615 и 87633
79750 и 88730
----------------------------141

Сумма: 852810

Ещё раз удесятеряем константу:
const limit = 1000000;

Project Euler. Problem 21
Дружественные числа до 1000000:
----------------------------220 и 284
1184 и 1210
2620 и 2924
5020 и 5564
6232 и 6368
10744 и 10856
12285 и 14595
17296 и 18416
63020 и 76084
66928 и 66992
67095 и 71145
69615 и 87633
79750 и 88730
100485 и 124155
122265 и 139815
122368 и 123152
141664 и 153176
142310 и 168730
171856 и 176336
176272 и 180848
185368 и 203432
196724 и 202444
280540 и 365084
308620 и 389924
319550 и 430402
356408 и 399592
437456 и 455344
469028 и 486178
503056 и 514736
522405 и 525915
600392 и 669688
142

609928 и 686072
624184 и 691256
635624 и 712216
643336 и 652664
667964 и 783556
726104 и 796696
802725 и 863835
879712 и 901424
898216 и 980984
----------------------------Сумма: 25275024

И для пущего удовлетворения любознательности последний раз удесятеряем эту константу:
const limit = 10000000;

Вот как крепко мы подружились с дружественными числами!
Project Euler. Problem 21
Дружественные числа до 10000000:
----------------------------220 и 284
1184
2620
5020
6232
10744
12285
17296
63020
66928
67095
69615
79750

и
и
и
и
и
и
и
и
и
и
и
и

1210
2924
5564
6368
10856
14595
18416
76084
66992
71145
87633
88730

635624
643336
667964
726104
802725
879712
898216

и
и
и
и
и
и
и

712216
652664
783556
796696
863835
901424
980984

947835 и 1125765
998104 и 1043096
1077890
1154450
1156870
1175265

и
и
и
и

1099390
1189150
1292570
1438983

3805264
4238984
4246130
4259750
4482765
4532710
4604776
5123090
5147032
5232010
5357625
5385310
5459176
5726072
5730615

и
и
и
и
и
и
и
и
и
и
и
и
и
и
и

4006736
4314616
4488910
4445050
5120595
6135962
5162744
5504110
5843048
5799542
5684679
5812130
5495264
6369928
6088905
143

100485
122265
122368
141664
142310
171856
176272
185368
196724
280540
308620
319550
356408
437456
469028
503056
522405
600392
609928
624184

и
и
и
и
и
и
и
и
и
и
и
и
и
и
и
и
и
и
и
и

124155
139815
123152
153176
168730
176336
180848
203432
202444
365084
389924
430402
399592
455344
486178
514736
525915
669688
686072
691256

1185376
1280565
1328470
1358595
1392368
1466150
1468324
1511930
1669910
1798875
2082464
2236570
2652728
2723792
2728726
2739704
2802416
2803580
3276856
3606850
3786904

и
и
и
и
и
и
и
и
и
и
и
и
и
и
и
и
и
и
и
и
и

1286744
1340235
1483850
1486845
1464592
1747930
1749212
1598470
2062570
1870245
2090656
2429030
2941672
2874064
3077354
2928136
2947216
3716164
3721544
3892670
4300136

5864660 и 7489324
6329416 и 6371384
6377175 и 6680025
6955216 и 7418864
6993610 и 7158710
7275532 и 7471508
7288930 и 8221598
7489112 и 7674088
7577350 и 8493050
7677248 и 7684672
7800544 и 7916696
7850512 и 8052488
8262136 и 8369864
8619765 и 9627915
9071685 и 9498555
9199496 и 9592504
9339704 и 9892936
9363584 и 9437056
----------------Сумма: 575875320

Для углубления и усугубления знаний о дружественных числах вдогонку
пишем ещё одну, коротюсенькую программульку:
##
// Подробный разбор примера 220 и 284
Writeln(' Пример: пара 220 и 284');
Writeln('=====================');
// Делители числа 220:
Writeln(' Делители 220:');
var divisors220 := new List<integer>;
for var i := 1 to 219 do
if 220 mod i = 0 then
divisors220.Add(i);
Writeln(' ' + string.Join(' + ', divisors220));
var sum220 := divisors220.Sum;
Writeln($' Сумма делителей 220 = {sum220}');
144

Writeln;
// Делители числа 284:
Writeln(' Делители 284:');
var divisors284 := new List<integer>;
for var i := 1 to 283 do
if 284 mod i = 0 then
divisors284.Add(i);
Writeln(' ' + string.Join(' + ', divisors284));
var sum284 := divisors284.Sum;
Writeln($' Сумма делителей 284 = {sum284}');
Writeln;
// проверяем на дружественность:
if (sum220 = 284) and (sum284 = 220) then begin
Writeln(' ✓ 220 и 284 - дружественные числа!');
Writeln(' d(220) = 284');
Writeln(' d(284) = 220');
end
else
Writeln('✗ 220 и 284 - НЕ дружественные');

И всё-таки они дружественные!
Пример: пара 220 и 284
=====================
Делители 220:
1 + 2 + 4 + 5 + 10 + 11 + 20 + 22 + 44 + 55 + 110
Сумма делителей 220 = 284
Делители 284:
1 + 2 + 4 + 71 + 142
Сумма делителей 284 = 220
✓ 220 и 284 - дружественные числа!
d(220) = 284
d(284) = 220

145

Проект Эйлер022
Исходный код программы находится в файле Эйлер022.pas.

Задача 22 (Problem 22) называется Names Scores.

Очки за имена
Используйте names.txt (щёлкнуть правой кнопкой мыши и выбрать 'Save
Link/Target As...'), текстовый файл размером 46 КБ, содержащий более пяти
тысяч имен. Начните с сортировки в алфавитном порядке. Затем подсчитайте алфавитные значения каждого имени и умножьте это значение на
порядковый номер имени в отсортированном списке для получения количества очков имени.
Например, если список отсортирован по алфавиту, имя COLIN (алфавитное
значение которого 3 + 15 + 12 + 9 + 14 = 53) является 938-м в списке. Поэтому,
имя COLIN получает 938 × 53 = 49714 очков.
Какова сумма очков имён в файле?
Начало текстового файла выглядит так:
"MARY","PATRICIA","LINDA","BARBARA","ELIZABETH","JENNIFER", …

Запятые и кавычки нужны здесь исключительно для усложнения задачи.
Из-за этого и потомучто мы вынуждены принуждением написать функцию
146

ParseNames, которая принимает длинную строку со всеми именами, кавычками и запятыми, а возвращает аккуратный список имён:
function ParseNames(text: string): List<string>;
begin
Result := new List<string>;
var name := '';
var inQuotes := false;
for var i := 1 to text.Length do begin
var ch := text[i];
case ch of
'"': begin
if inQuotes then begin
// закрывающая кавычка:
if name.Length > 0 then begin
Result.Add(name);
name := '';
end;
end;
inQuotes := not inQuotes;
end;
'A'..'Z':
if inQuotes then
name += ch;
// остальные символы пропускаем
end;
end;
end;

Для решения задачи нам также нужна функция AlphabeticalValue, которая
получает от нас имя, а возвращает очки за него:
uses MathExtensions;
function AlphabeticalValue(name: string): int;
begin
Result := 0;
foreach var ch in name do
Result += Ord(ch) - Ord('A') + 1;
147

end;

Если бы не эти тяготы, задача решалась бы гораздо проще – поимённым голосованием:
// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
var path := 'p022_names.txt';
var text := ReadAllLines(path)[0];
var names := ParseNames(text);
Writeln('Найдено имен: ', names.Count);
// сортируем:
names.Sort;
// для проверки печатаем первые 5 имен:
Writeln('Первые 5 имен после сортировки:');
for var i := 0 to Min(4, names.Count - 1) do
Writeln($' {i + 1}: {names[i]}');
// вычисляем результат:
var totalScore: int64 := 0;
for var i := 0 to names.Count - 1 do
totalScore += AlphabeticalValue(names[i]) * (i + 1);
Writeln;
Writeln($' Суммарный результат: {totalScore}');
// правильный ответ: 871198282
Writeln;
end;

begin
Writeln(' Project Euler. Problem 22');
Writeln;
Solve();
end.

148

И что же мы видим на экране после запуска программы? – Она работает исправно и покладисто, выдав правильный ответ на очередную эйлерову закавыку:
Project Euler. Problem 22
Найдено имен: 5163
Первые 5 имен после сортировки:
1: AARON
2: ABBEY
3: ABBIE
4: ABBY
5: ABDUL
Суммарный результат: 871198282

Проект Эйлер023
Исходный код программы находится в файле Эйлер023.pas.

Задача 23 (Problem 23) называется Non-Abundant Sums.

Недостаточные суммы
149

Совершенным числом называется число, у которого сумма его делителей
равна самому числу. Например, сумма делителей числа 28 равна 1 + 2 + 4 + 7
+ 14 = 28, что означает, что число 28 является совершенным числом.
Число n называется недостаточным, если сумма его делителей меньше n, и
называется избыточным, если сумма его делителей больше n.
Так как число 12 является наименьшим избыточным числом (1 + 2 + 3 + 4 + 6
= 16), наименьшее число, которое может быть записано как сумма двух избыточных чисел, равно 24. Используя математический анализ, можно показать, что все целые числа больше 28123 могут быть записаны как сумма
двух избыточных чисел. Эта граница не может быть уменьшена дальнейшим анализом, даже несмотря на то, что наибольшее число, которое не может быть записано как сумма двух избыточных чисел, меньше этой границы.
Найдите сумму всех положительных чисел, которые не могут быть
записаны как сумма двух избыточных чисел.
Сумма собственных делителей числа называется аликвотной суммой.
Если аликвотная сумма равна числу, то число совершенное.
Если аликвотная сумма больше числа, то число избыточное.
Если аликвотная сумма меньше числа, то число недостаточное.
Нам нужно проверить все натуральные числа ≤ 28123.
При внимательном чтении условия задачи становится ясно, что нам нужны
все делители заданного числа, а также их сумма. Для этого в модуле
MathExtensions у нас есть метод расширения Divisors, который возвращает все делители заданного числа, включая само число, от которого мы
избавляемся. Метод расширения Sum находит сумму всех делителей:
// ВОЗВРАЩАЕТ ВСЕ ДЕЛИТЕЛИ ЧИСЛА,
// ВКЛЮЧАЯ САМО ЧИСЛО
function Divisors(self: int): sequence of int; extensionmethod;
begin
var n := Abs(self);
// возвращаем 1:
yield 1;
150

if n = 1 then exit;
// возвращаем делители 2.. < n:
for var i := 2 to ISqrt(n) do begin
if n mod i = 0 then begin
yield i;
var complement := n div i;
if complement <> i then
yield complement;
end;
end;
// возвращаем само число:
yield n;
end;
uses MathExtensions;

// ВОЗВРАЩАЕТ СУММУ ВСЕХ ДЕЛИТЕЛЕЙ ЧИСЛА,
// КРОМЕ САМОГО ЧИСЛА
function SumOfDivisors(n: int) := n.Divisors.Sum - n;

Зная сумму делителей, мы легко, но быстро просеем избыточные числа:
// ИЗБЫТОЧНОЕ ЧИСЛО?
function IsAbundant(n: int) := SumOfDivisors(n) > n;

Можно браться за задачу:
begin
Writeln(' Project Euler. Problem 23');
Writeln;
Solve();
end.

А берёмся мы за неё в процедуре по имени Solve:
151

// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
var limit := 28123;

Собираем все избыточные числа в список:
// все избыточные числа до limit:
var abundantNumbers := new List<int>;

Заполняем список избыточными числами, начиная с дюжинного числа 12:
// 12 - первое избыточное число:
for var i := 12 to limit do
if IsAbundant(i) then
abundantNumbers.Add(i);
Writeln($' Найдено избыточных чисел: {abundantNumbers.Count}');
Writeln(' Первые 10 избыточных чисел:');
for var i := 0 to Min(9, abundantNumbers.Count - 1) do
Write($' {abundantNumbers[i]} ');
Writeln;

Теперь мы отыщем числа, которые можно представить как сумму двух избыточных чисел, из готового списка таких чисел: abundantNumbers:
// отмечаем все числа,
// которые можно представить как сумму двух избыточных:
var canBeExpressed := new bool[limit + 1];
for var i := 0 to abundantNumbers.Count - 1 do
for var j := i to abundantNumbers.Count - 1 do begin

Перебираем все пары избыточных чисел, которые могут дать число, не превышающее limit:
152

var sum := abundantNumbers[i] + abundantNumbers[j];

Отмечаем «трюизмами» числа, которые не подпадают под условие задачи:
if sum <= limit then
canBeExpressed[sum] := true;
end;

Находим сумму остальных чисел. Они имеют ложное значение в логическом
массиве canBeExpressed:
// суммируем числа,
// которые нельзя выразить как сумму двух избыточных:
var totalSum := 0;
var count := 0;
for var i := 1 to limit do
if not canBeExpressed[i] then begin
totalSum += i;
count += 1;
end;

Отчитываемся перед герром Эйлером о проделанной работе:
Writeln;
Writeln($' Всего таких чисел: {count}');
Writeln($' Их сумма = {totalSum}');
Writeln;
// ответ: 4179871
end;

Отчёт принят:
Project Euler. Problem 23
153

Найдено избыточных чисел: 6965
Первые 10 избыточных чисел:
12 18 20 24 30 36 40 42

48

54

Всего таких чисел: 1456
Их сумма = 4179871

Проект Эйлер024
Исходный код программы находится в файле Эйлер024.pas.

Задача 24 (Problem 24) называется Lexicographic Permutations.
A permutation is an ordered arrangement of objects. For example, 3124 is one possible permutation of the digits 1, 2, 3 and 4. If all of the permutations are listed numerically or alphabetically, we call it lexicographic order. The lexicographic permutations of 0, 1 and 2 are:
012 021 102 120 201 210
What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8
and 9?
Лексикографические перестановки
Перестановка - это упорядоченная выборка объектов. К примеру, 3124 является одной из возможных перестановок из цифр 1, 2, 3 и 4. Если все перестановки приведены в порядке возрастания или в алфавитном порядке, то такой порядок будем называть лексикографическим. Лексикографические перестановки из цифр 0, 1 и 2 представлены ниже:
012 021 102 120 201 210
154

Какова миллионная лексикографическая перестановка из цифр 0, 1, 2,
3, 4, 5, 6, 7, 8 и 9?
В паскале есть метод расширения Permutations для массивов и последовательностей, поэтому мы можем поместить все цифры в один из этих типов
данных:
uses MathExtensions;

// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
// цифры:
var digits := (0..9);
// номер нужной перестановки
var target := 1000000;
var count := 0;
var res := '';

И в цикле foreach спокойно и аккуратно считаем перестановки этих цифр:
// перебираем все перестановки
foreach var perm in digits.Permutations do begin
count += 1;
if count = target then begin

Метод расширения Permutations возвращает массив цифр, поэтому мы
формируем из них строку:
// собираем перестановку в строку:
foreach var digit in perm do
res += digit.ToString;
break;
end;
end;
155

И печатаем на экране:
Writeln($' Миллионная перестановка: {result}');
Writeln;
// ответ: 2783915460
end;

begin
Writeln(' Project Euler. Problem 24');
Writeln;
Solve();
end.

Паскаль нас не подвёл:
Project Euler. Problem 24
Миллионная перестановка: 2783915460

156

Проект Эйлер025
Исходный код программы находится в файле Эйлер025.pas.

Задача 25 (Problem 25) называется 1000-digit Fibonacci Number.

1000-значное число Фибоначчи
Последовательность Фибоначчи определяется рекурсивным правилом:
Fn = Fn−1 + Fn−2, где F1 = 1 и F2 = 1.
Таким образом, первые 12 членов последовательности равны:
F1 = 1
F2 = 1
F3 = 2
F4 = 3
F5 = 5
157

F6 = 8
F7 = 13
F8 = 21
F9 = 34
F10 = 55
F11 = 89
F12 = 144
Двенадцатый член F12 - первый член последовательности, который содержит
три цифры.
Каков порядковый номер первого члена последовательности Фибоначчи,
содержащего 1000 цифр?

Числа Фибоначчи известны даже зайцам, поэтому мы сразу вытаскиваем из
шляпы этих зайцев:
begin
Writeln(' Project Euler. Problem 25');
WriteLn;
Solve();
end.

Сначала мы обойдёмся своими силами и самостоятельно вычислим все
числа Фибоначчи. Небольшие неприятности доставят нам большие числа –
и только:
procedure Solve();
begin
var a := BigInteger.One;
var b := BigInteger.One;
var id := 2;

// F(1)
// F(2)
// Индекс текущего числа b

while true do begin
// печатаем ответ:
if b.ToString.Length >= 1000 then begin
Writeln($' Порядковый номер = {id}');
158

break;
end;
// вычисляем следующее число Фибоначчи:
(a, b) := (b, (a + b));
id += 1;
end;
// 4782
end;

И раз такое дело и на то дело пошло, давайте напишем новый модуль
FibonacciBigInt, а в нём – генератор зайцев SequenceFibo:
159

/// ГЕНЕРИРУЕТ БОЛЬШИЕ ЧИСЛА ФИБОНАЧЧИ
class function Fibonacci.SequenceFibo(): sequence of BigInteger;
begin
var a := BigInteger.Zero;
var b := BigInteger.One;
yield a; // F₀
yield b; // F₁
while true do
begin
var next := a + b;
yield next;
a := b;
b := next;
end;
end;

Теперь мы рассчитаемся с зайцами и того проще:
procedure Solve2();
begin
var id := 0;
foreach var f in Fibonacci.SequenceFibo() do begin
// печатаем ответ:
if f.ToString.Length >= 1000 then begin
Writeln($' Порядковый номер = {id}');
break;
end;
id += 1;
end;
WriteLn;
end;

И вот их сколько наплодилось:
Project Euler. Problem 25
Порядковый номер = 4782
Порядковый номер = 4782
160

Проект Эйлер026
Исходный код программы находится в файле Эйлер026.pas.

Задача 26 (Problem 26) называется Reciprocal Cycles.

Длинные периоды
Единичная дробь имеет 1 в числителе. Десятичные представления единичных
дробей со знаменателями от 2 до 10 даны в таблице.
1
0.1(6) значит 0.166666..., и имеет повторяющуюся последовательность из одной цифры. Заметим, что 1/7 имеет повторяющуюся
последовательность из 6 цифр.
Найдите значение d < 1000, для которого 1/d в десятичном виде
содержит самую длинную повторяющуюся последовательность
цифр.

/2 = 0.5
/3 = 0.(3)
1
/4 = 0.25
1
/5 = 0.2
1
/6 = 0.1(6)
1
/7 = 0.(142857)
1
/8 = 0.125
1
/9 = 0.(1)
1
/10 = 0.1
1

О циклических числах читайте дальше. Из этого проекта мы и возьмём код
для решения этой задачи.
161

Поскольку мы в будущем мы уже решили проблему с вычислением периодов простых дробей, то с помощью машины времени мы скопипастим код
оттуда и добавим ему уму в соответствии с условиями этой задачи.
uses MathExtensions;
// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin

Эти переменные нам нужны для запоминания информации о самом длинном периоде и о числе, который его порождает:
var long := 0;
var longd := 0;
var longp := String.Empty;

В данном случае мы проверяем все числа в заданном диапазоне, а не только
простые числа, что было бы правильно:
for var d := 2 to 1000 do begin
// алгоритм деления в столбик для нахождения периода:
var remainder := 1;
var digits := new List<char>;
var remainders := new Dictionary<int, int>;
var position := 0;
var periodFound := false;
var periodStart := 0;
while not periodFound and (position < 2000) do begin
if remainders.ContainsKey(remainder) then begin
periodFound := true;
periodStart := remainders[remainder];
end
else begin
remainders[remainder] := position;
remainder := remainder * 10;
digits.Add(char(ord('0') + remainder div d));
162

remainder := remainder mod d;
position += 1;
end;
end;

Период для очередного числа найден. Если он длиннее рекордного, то запоминаем его в вышеопределённых переменных:
if periodFound then begin
var periodLength := digits.Count - periodStart;
if periodLength > long then begin
long := periodLength;
longd := d;
var p := String.Empty;
for var i := periodStart to digits.Count - 1 do
p += digits[i];
longp := p;
end;
Writeln($' d = {d} период: ', periodLength, ' цифр');
end;
end;

Периодическая таблица заполнена доверху. Публикуем!
Writeln($' Самый длинный период = {long} для числа {longd} =
{longp}');
Writeln;
end;

begin
Writeln(' Project Euler. Problem 26');
WriteLn;
Solve;
end.

Ответ на задачу раскрывает секретную хитрость составителей задачи: простое число 983 даёт периодическую дробь с длиной периода 982 цифры!
163

Project Euler. Problem 26
d
d
d
d
d
d
d
d
d
d

=
=
=
=
=
=
=
=
=
=

...

2
3
4
5
6
7
8
9
10
11

период: 1 цифр
период: 1 цифр
период: 1 цифр
период: 1 цифр
период: 1 цифр
период: 6 цифр
период: 1 цифр
период: 1 цифр
период: 1 цифр
период: 2 цифр

d = 983 период: 982 цифр
d = 984 период: 5 цифр
d = 985 период: 98 цифр
d = 986 период: 112 цифр
d = 987 период: 138 цифр
d = 988 период: 18 цифр
d = 989 период: 462 цифр
d = 990 период: 2 цифр
d = 991 период: 495 цифр
d = 992 период: 15 цифр
d = 993 период: 110 цифр
d = 994 период: 210 цифр
d = 995 период: 99 цифр
d = 996 период: 41 цифр
d = 997 период: 166 цифр
d = 998 период: 498 цифр
d = 999 период: 3 цифр
d = 1000 период: 1 цифр
Самый длинный период = 982 для числа 983 =
0010172939979654120040691759918616480162767039674465920651068158697863682
6042726347914547304170905391658189216683621566632756866734486266531027466
9379450661241098677517802644964394710071210579857578840284842319430315361
1393692777212614445574771108850457782299084435401831129196337741607324516
7853509664292980671414038657171922685656154628687690742624618514750762970
4984740590030518819938962360122075279755849440488301119023397761953204476
0935910478128179043743641912512716174974567650050864699898270600203458799
5930824008138351983723296032553407934893184130213631739572736520854526958
2909460834181078331637843336724313326551373346897253306205493387589013224
8219735503560528992878942014242115971515768056968463886063072227873855544
164

2522889114954221770091556459816887080366225839267548321464903357070193285
8596134282807731434384537131230925737538148524923702950152594099694811800
6103763987792472024415055951169888097660223804679552390640895218718209562
563580874872838250254323499491353

165

Проект Эйлер027
Исходный код программы находится в файле Эйлер027.pas.

Задача 27 (Problem 27) называется Quadratic Primes.

Квадратичные простые числа

166

Вот, наконец, задача, непосредственно связанная с именем Леонарда Эйлера!
Если n = 0, то 0² + a*0 + b = b, поэтому b должно быть простым числом, и
|b| ≤ 1000.
Начинаем решать задачу:
begin
Writeln(' Project Euler. Problem 27');
WriteLn;
Solve;
end.

У нас есть метод расширения для целых чисел IsPrime, поэтому мы быстро
и лихо соберём все простые числа в список primeBs:
// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin
// лучшие значения:
var maxPrimes := 0;
var bestA := 0;
var bestB := 0;
// все простые числа b в диапазоне [-1000, 1000]:
var primeBs := new List<int>;
for var b := 2 to 1000 do
if b.IsPrime then
primeBs.Add(b);
Writeln($' Простые b в диапазоне [-1000, 1000]: {primeBs.Count}');

Всего таких чисел 336:
Project Euler. Problem 27
Простые b в диапазоне [-1000, 1000]: 168
167

Теперь в списке primeBs надёжно хранятся все возможные значения параметра b. Из условия задачи нам известно, что |a| < 1000.
В двух циклах получаем все возможные пары чисел a и b:
// перебираем все возможные a и b:
for var a := -999 to 999 do begin
for var i := 0 to primeBs.Count - 1 do begin
var b := primeBs[i];

А функции CountPrimes возвращает число последовательных простых по
формуле для текущих значений a и b:
// подсчитываем, простые числа
// для этих значений:
var primesCount := CountPrimes(a, b);
uses MathExtensions;

// СКОЛЬКО ПОСЛЕДОВАТЕЛЬНЫХ ПРОСТЫХ ЧИСЕЛ ДАЕТ ФОРМУЛА N2 + AN + B,
// НАЧИНАЯ С N = 0
function CountPrimes(a, b: integer): integer;
begin
// счётчик:
var n := 0;
while true do begin
var num := n*n + a*n + b;
if not num.IsPrime then break;
n += 1;
end;
// кол-во последовательных простых чисел:
Result := n;
end;

Получив лучшее решение, немедля показываем его себе на экране:
// обновляем рекорд:
if primesCount > maxPrimes then begin
168

maxPrimes := primesCount;
bestA := a;
bestB := b;
// печатаем лучшие результаты:
Writeln($' Новый максимум: a = {a,4}, b = {b,4}, простых чисел: {primesCount,3}, произведение: {a*b,6}');
end;
end;
end;

Наглядно получилось на загляденье:
Новый
Новый
Новый
Новый
Новый
Новый
Новый
Новый
Новый
Новый
Новый

максимум:
максимум:
максимум:
максимум:
максимум:
максимум:
максимум:
максимум:
максимум:
максимум:
максимум:

a
a
a
a
a
a
a
a
a
a
a

=
=
=
=
=
=
=
=
=
=
=

-999,
-996,
-499,
-325,
-245,
-197,
-163,
-131,
-121,
-105,
-61,

b
b
b
b
b
b
b
b
b
b
b

=
=
=
=
=
=
=
=
=
=
=

2,
997,
997,
977,
977,
983,
983,
941,
947,
967,
971,

простых
простых
простых
простых
простых
простых
простых
простых
простых
простых
простых

чисел:
чисел:
чисел:
чисел:
чисел:
чисел:
чисел:
чисел:
чисел:
чисел:
чисел:

1,
2,
3,
4,
5,
6,
7,
8,
9,
11,
71,

произведение:
произведение:
произведение:
произведение:
произведение:
произведение:
произведение:
произведение:
произведение:
произведение:
произведение:

-1998
-993012
-497503
-317525
-239365
-193651
-160229
-123271
-114587
-101535
-59231

В конце списка мы уже видим ответ на задачу, но дополнительно услаждаем
свой взор конкретной информацией, не оставляющей никаких сомнений в
правильности нашего решения задачи:
Writeln;
Writeln('=' * 70);
Writeln(' РЕЗУЛЬТАТ:');
Writeln($' a = {bestA}');
Writeln($' b = {bestB}');
Writeln($' Кол-во последовательных простых чисел = {maxPrimes}');
Writeln($' Произведение a ? b = {bestA * bestB}');
Writeln('=' * 70);

======================================================================
РЕЗУЛЬТАТ:
169

a = -61
b = 971
Кол-во последовательных простых чисел = 71
Произведение a × b = -59231
======================================================================

Для успокоения души проверяем наше решение:
// проверяем решение:
Writeln;
Writeln($' Проверка формулы n? + {bestA}n + {bestB}:');
for var n := 0 to maxPrimes - 1 do begin
var num := n*n + bestA*n + bestB;
Writeln($' n = {n,2}: {n*n,4} + {bestA*n,5} + {bestB,5}
({num.IsPrime})');
end;
end;

= {num,6}

Всё сходится тютелька в тютельку:
Проверка формулы n² + -61n + 971:
n = 0:
0 +
0 +
971 =
n = 1:
1 +
-61 +
971 =
n = 2:
4 + -122 +
971 =
n = 3:
9 + -183 +
971 =
n = 4:
16 + -244 +
971 =
n = 5:
25 + -305 +
971 =
n = 6:
36 + -366 +
971 =
n = 7:
49 + -427 +
971 =

...
n
n
n
n
n
n
n
n

=
=
=
=
=
=
=
=

63:
64:
65:
66:
67:
68:
69:
70:

3969
4096
4225
4356
4489
4624
4761
4900

+
+
+
+
+
+
+
+

-3843
-3904
-3965
-4026
-4087
-4148
-4209
-4270

+
+
+
+
+
+
+
+

971
971
971
971
971
971
971
971

=
=
=
=
=
=
=
=

971
911
853
797
743
691
641
593

(True)
(True)
(True)
(True)
(True)
(True)
(True)
(True)

1097
1163
1231
1301
1373
1447
1523
1601

(True)
(True)
(True)
(True)
(True)
(True)
(True)
(True)

170

Тут даже крот не подкопается!

Проект Эйлер028
Исходный код программы находится в файле Эйлер028.pas.

Задача 28 (Problem 28) называется Number Spiral Diagonals.

171

Диагонали числовой спирали
Начиная с числа 1 и двигаясь дальше вправо по часовой стрелке, образуется
следующая спираль 5 на 5:
21 22 23 24 25
20 7 8 9 10
19 6 1 2 11
18 5 4 3 12
17 16 15 14 13
Можно убедиться, что сумма чисел в диагоналях равна 101.
Какова сумма чисел в диагоналях спирали 1001 на 1001, образованной таким же способом?

Прежде чем браться за решение задачи, давайте пристально посмотрим на
числовую спираль.
Она квадратная, с нечётными сторонами, в центре всегда прочно стоит единица. Длина сторон квадратов – 1, 3, 5, 7, … Нас интересуют числа в вершинах этих квадратов:
Квадрат 0: 1 × 1 → 1
Квадрат 1: 3 × 3 → 3, 5, 7, 9
Квадрат 2: 5 × 5 → 13, 17, 21, 25
Квадрат 3: 7 × 7 → 31, 37, 43, 49
Если n – это номер квадрата, то расстояние между числами в вершинах
квадрата равно 2n.
После таких рассуждений можно смело браться за решение задачи.
// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin
// размер спирали
var size := 1001;
172

// сумма чисел в вершинах квадрата:
var sum := 1;
// число в вершине квадрата:
var current := 1;
// квадраты:
for var n := 1 to (size - 1) div 2 do begin
// шаг между диагональными числами в одном квадрате:
var step := 2 * n;
// 4 диагональных числа в этом квадрате:
loop 4 do begin
current += step;
sum += current;
end;
end;
Writeln($' Спираль {size} ? {size}');
Writeln($' Сумма чисел по диагоналям: {sum}');
end;
begin
Writeln(' Project Euler. Problem 28');
WriteLn;
Solve;
end.

Спираль закручена – задача раскручена:
Project Euler. Problem 28
Спираль 1001 × 1001
Сумма чисел по диагоналям: 669171001

Проект Спираль Улама
Исходный код программы находится в файле Спираль Улама.pas,
Спираль Улама 2.pas, Спираль Улама 3.pas, Спираль Улама 4.pas.

173

Согласно легенде, американский математик польского происхождения Станислав Улам вычертил числовую спираль на каком-то скучном докладе. Говорят, что это было более 60 лет назад, в 1963 году. Эту числовую загогулину называют спиралью (или скатертью) Улама (Ulam Spiral).

Квадрат Улама из книги Математические досуги Мартина Гарднера
С точки зрения программирования, задача формулируется так:
Начиная с 1 и двигаясь против часовой стрелки по спирали, заполнить квадратную матрицу последовательными числами.
На первый взгляд, спираль Улама ничем не примечательна, но он высмотрел в ней интересные закономерности, связанные с простыми числами (поэтому её называют также Prime Number Spiral). У него это вышло случайно,
когда он обводил кружками простые числа. Поскольку нам уже поздно полагаться на случай, то мы намеренно выкрасим в синий цвет клетки с простыми числами.
Легко заметить, глядючи на рисунок⬆, что эта спираль не отличается от
спирали из задачи Проект Эйлера 028, поэтому мы не станем повторяться с
числами, а нарисуем спираль в клеточку. Ежели закрасить клетки с простыми числами, то диагонали с простыми числами покажут себя во всей
красе.
174

Для вычерчивания спиральных клеточек мы используем модуль
GraphWPF, а для просева простых чисел – наш модуль MathExtensions:
uses GraphWPF, MathExtensions;

Сразу создаём окно надлежащих размеров, вызываем процедуру
DrawUlamSpiral для вычерчивания спирали и назначаем функцию-обработчик нажатия на клавиши:
begin
Window.SetSize(650, 670);
Window.CenterOnScreen;
// спираль по умолчанию:
DrawUlamSpiral(41, 15);
// функция - обработчик клавиш:
OnKeyDown := KeyDown;
// инструкция:
Writeln(' Управление:');
Writeln(' 1 - спираль 21х21');
Writeln(' 2 - спираль 31х31');
Writeln(' 3 - спираль 41х41');
Writeln(' 4 - спираль 51х51');
Writeln(' Esc - выход');
end.

Клавиши 1..4 чертят спирали разного размера:
// ОБРАБОТЧИК НАЖАТИЯ НА КЛАВИШИ
procedure KeyDown(k: Key);
begin
case k of
Key.D1: begin
Window.SetSize(600, 600); DrawUlamSpiral(21, 25); end;
Key.D2: begin
Window.SetSize(600, 610); DrawUlamSpiral(31, 18); end;
Key.D3: begin
175

Window.SetSize(650, 670); DrawUlamSpiral(41, 15); end;
Key.D4: begin
Window.SetSize(700, 690); DrawUlamSpiral(51, 12); end;
Key.Escape: Window.Close;
end;
end;

Самая главная процедура программы – DrawUlamSpiral. Она получает
длину стороны квадратной спирали и размер клеток:
// ЧЕРТИМ СПИРАЛЬ УЛАМА
procedure DrawUlamSpiral(size, cellSize: int);
begin
Window.Clear;
Window.Title := $' Спираль Улама {size} ? {size}';

Затем вычерчивает спираль:
var
var
var
var

spiral := new int[size, size];
x := size div 2;
y := size div 2;
num := 1;

// заполняем спираль:
var dirs := Arr((0,1), (1,0), (0,-1), (-1,0));
var dirIdx := 0;
var steps := 1;
while num <= size*size do begin
spiral[x, y] := num;
for var i := 1 to 2 do begin
var (dx, dy) := dirs[dirIdx];
for var j := 1 to steps do begin
x += dx;
y += dy;
num += 1;
if num <= size*size then
spiral[x, y] := num;
end;
176

dirIdx := (dirIdx + 1) mod 4;
end;
steps += 1;
end;
// спираль:
var offsetX := (Window.Width - size * cellSize) / 2;
var offsetY := (Window.Height - size * cellSize) / 2;
for var i := 0 to size - 1 do
for var j := 0 to size - 1 do begin
var cellX := offsetX + j * cellSize;
var cellY := offsetY + i * cellSize;
// клетка:
Pen.Color := Colors.LightGray;
Brush.Color := Colors.White;
Rectangle(cellX, cellY, cellSize, cellSize);

И закрашивает для нашего удовольствия синим цветом клетки с простыми
числами:
// закрашиваем простые числа:
if spiral[i, j].IsPrime then begin
Brush.Color := Colors.Blue;
FillRectangle(cellX + 1, cellY + 1, cellSize - 2, cellSize - 2);
end;
// печатаем число (для маленьких спиралей):
if cellSize > 20 then begin
Brush.Color := Colors.Transparent;
Font.Size := 8;
TextOut(cellX + 2, cellY + 2, spiral[i, j].ToString);
end;
end;
Brush.Color := Colors.White;
Font.Size := 12;
TextOut(10, Window.Height - 20, 'Синие клетки - простые числа');
end;

177

Протяжённость и обилие диагоналей зависят от размера спирали, так что
вы можете смело и умело экспериментировать с этой штуковиной!

Для любителей и знатоков числовой изящности пишем разноцветную программу:
178

uses GraphWPF, Timers, MathExtensions;

var
currentSize: int;
cellSize: int;
showNumbers: bool := true;
// 0 - синий, 1 - радуга, 2 - тепловая карта
colorMode: int := 0;

// ВОЗВРАЩАЕТ ЦВЕТ КЛЕТОК
function GetPrimeColor(n: integer): Color;
begin
case colorMode of
0: Result := Colors.Blue;
1: Result := Color.FromRgb(Random(256), Random(256), Random(256));
// тепловая карта: чем больше n, тем "теплее" цвет
2: begin
var intensity := Min(255, n div 10);
Result := Color.FromRgb(255, 255 - intensity, 255 - intensity);
end;
else Result := Colors.Blue;
end;
end;

// ЧЕРТИТ СПИРАЛЬ УЛАМА
procedure DrawUlamSpiral(size: integer);
begin
currentSize := size;
cellSize := Round(Min(Window.Width, Window.Height) / size) - 2;
Window.Clear(Colors.White);
Window.Title := $' Спираль Улама {size} ? {size} (цвет: ' +
if colorMode = 0 then 'синий)' else if colorMode = 1
then 'радуга)' else 'тепло)';
var spiral := new integer[size, size];
var x := size div 2;
var y := size div 2;
179

var num := 1;
// заполняем спираль:
var dirs := Arr((0,1), (1,0), (0,-1), (-1,0));
var dirIdx := 0;
var steps := 1;
while num <= size*size do begin
spiral[x, y] := num;
for var i := 1 to 2 do begin
var (dx, dy) := dirs[dirIdx];
for var j := 1 to steps do begin
x += dx;
y += dy;
num += 1;
if num <= size*size then
spiral[x, y] := num;
end;
dirIdx := (dirIdx + 1) mod 4;
end;
steps += 1;
end;
// рисуем спираль:
var offsetX := (Window.Width - size * cellSize) / 2;
var offsetY := (Window.Height - size * cellSize) / 2;
for var i := 0 to size - 1 do
for var j := 0 to size - 1 do begin
var cellX := offsetX + j * cellSize;
var cellY := offsetY + i * cellSize;
var number := spiral[i, j];
// рисуем клетку:
Pen.Color := Colors.LightGray;
Brush.Color := Colors.White;
Rectangle(cellX, cellY, cellSize, cellSize);
// закрашиваем простые числа:
if number.IsPrime then begin
Brush.Color := GetPrimeColor(number);
FillRectangle(cellX + 1, cellY + 1, cellSize - 2, cellSize
- 2);
end;
180

// печатаем число:
if showNumbers and (cellSize > 15) then begin
Brush.Color := Colors.Transparent;
Font.Size := Max(6, cellSize div 3);
var textColor := if number.IsPrime then Colors.White else
Colors.Black;
DrawText(cellX + 2, cellY + 2, cellSize - 4, cellSize - 4,
number, textColor);
end;
end;
// считаем простые числа:
var primeCount := 0;
for var i := 0 to size - 1 do
for var j := 0 to size - 1 do
if spiral[i, j].IsPrime then
primeCount += 1;
// надписи:
Brush.Color := Colors.Transparent;
Font.Size := 14;
TextOut(10, 0, $' Спираль Улама {size} ? {size}');
Font.Size := 12;
TextOut(10, 22, $' Простых чисел: {primeCount} ({Round((primeCount *
100 / (size*size)), 2)}%)');
TextOut(10, Window.Height - 30, 'Управление: 1-4 размер, C - цвета, N
- числа, Esc - выход');
end;

procedure KeyDown(k: Key);
begin
case k of
Key.D1: begin
Window.SetSize(500, 500); DrawUlamSpiral(21); end;
Key.D2: begin
Window.SetSize(600, 600); DrawUlamSpiral(31); end;
Key.D3: begin
Window.SetSize(700, 700); DrawUlamSpiral(41); end;
Key.D4: begin
Window.SetSize(800, 800); DrawUlamSpiral(51); end;
Key.D5: begin
Window.SetSize(1000, 960); DrawUlamSpiral(71); end;
181

Key.C: begin
colorMode := (colorMode + 1) mod 3;
DrawUlamSpiral(currentSize); end;
Key.N: begin
showNumbers := not showNumbers;
DrawUlamSpiral(currentSize); end;
Key.Escape: Window.Close;
end;
end;

begin
Window.SetSize(700, 700);
Window.CenterOnScreen;
// начальная спираль:
DrawUlamSpiral(41);
// обработчик нажатия на клавиши:
OnKeyDown := KeyDown;
// инструкция в консоли:
Writeln(' Управление:');
Writeln(' 1 - спираль 21?21');
Writeln(' 2 - спираль 31?31');
Writeln(' 3 - спираль 41?41');
Writeln(' 4 - спираль 51?51');
Writeln(' 5 - спираль 71?71');
Writeln(' C - переключение цветовой схемы');
Writeln(' N - показать/скрыть числа');
Writeln(' Esc - выход');
end.

Не побоюсь сказать: то, что я вижу, получилось чертовски изящно!

182

Желающие понаблюдать за процессом верчения спирали могут это сделать
со следующей программой:
uses GraphWPF, Timers, MathExtensions;
var
183

// таймер:
tim: Timer;
currentStep: integer;
maxSteps: integer;
spiral: array [,] of integer;
size: integer := 41;
// отслеживаем построенные ячейки
builtSpiral: array [,] of boolean;

// ГОТОВИМ СПИРАЛЬ
procedure InitializeSpiral;
begin
spiral := new int[size, size];
builtSpiral := new bool[size, size];
var x := size div 2;
var y := size div 2;
var num := 1;
var dirs := Arr((0,1), (1,0), (0,-1), (-1,0));
var dirIdx := 0;
var steps := 1;
// вычисляем все клетки спирали:
while num <= size*size do begin
spiral[x, y] := num;
for var i := 1 to 2 do begin
var (dx, dy) := dirs[dirIdx];
for var j := 1 to steps do begin
x += dx;
y += dy;
num += 1;
if num <= size*size then
spiral[x, y] := num;
end;
dirIdx := (dirIdx + 1) mod 4;
end;
steps += 1;
end;
maxSteps := size * size;
currentStep := 0;
end;
184

// РИСУЕМ КЛЕТКУ
procedure DrawCell(i, j: integer);
begin
var cellSize := Round(Min(Window.Width, Window.Height) / size) - 2;
var offsetX := (Window.Width - size * cellSize) / 2;
var offsetY := (Window.Height - size * cellSize) / 2;
var cellX := offsetX + j * cellSize;
var cellY := offsetY + i * cellSize;
var number := spiral[i, j];
// рисуем клетку:
Pen.Color := Colors.LightGray;
Brush.Color := Colors.White;
Rectangle(cellX, cellY, cellSize, cellSize);
// закрашиваем простые числа:
if (number.IsPrime) then begin
Brush.Color := Colors.Blue;
FillRectangle(cellX + 1, cellY + 1, cellSize - 2, cellSize - 2);
end;
// печатаем число:
if cellSize > 15 then begin
Brush.Color := Colors.Transparent;
Font.Size := Max(6, cellSize div 3);
var textColor := if (number.IsPrime) then Colors.White else Colors.Black;
DrawText(cellX + 2, cellY + 2, cellSize - 4, cellSize - 4,
number.ToString, textColor);
end;
end;
// АНИМАЦИЯ
procedure DrawStep;
begin
if currentStep >= maxSteps then begin
tim.Stop;
exit;
end;
// координаты текущего числа в спирали:
var found := false;
var ci := 0;
185

var cj := 0;
for var i := 0 to size - 1 do begin
for var j := 0 to size - 1 do begin
if spiral[i, j] = currentStep + 1 then begin
ci := i;
cj := j;
found := true;
break;
end;
end;
if found then break;
end;
// рисуем одну ячейку:
if found and not builtSpiral[ci, cj] then begin
DrawCell(ci, cj);
builtSpiral[ci, cj] := true;
end;
currentStep += 1;
end;
// НАЧИНАЕМ АНИМАЦИЮ
procedure StartAnimation(spiralSize: int);
begin
if tim <> nil then
tim.Stop;
size := spiralSize;
InitializeSpiral;
// очищаем окно:
Window.Clear(Colors.White);
// рисуем сетку
var cellSize := Round(Min(Window.Width, Window.Height) / size) - 2;
var offsetX := (Window.Width - size * cellSize) / 2;
var offsetY := (Window.Height - size * cellSize) / 2;
// рисуем пустую сетку:
for var i := 0 to size - 1 do
for var j := 0 to size - 1 do begin
var cellX := offsetX + j * cellSize;
var cellY := offsetY + i * cellSize;
186

Pen.Color := Colors.LightGray;
Brush.Color := Colors.White;
Rectangle(cellX, cellY, cellSize, cellSize);
end;
// запускаем таймер:
tim := new Timer(5, DrawStep);
tim.Start;
end;

// ПРОЦЕДУРА ОБРАБОТКИ НАЖАТИЯ НА КЛАВИШИ
procedure KeyDown(k: Key);
begin
case k of
Key.D1: begin Window.SetSize(500, 500); StartAnimation(21);
Key.D2: begin Window.SetSize(600, 600); StartAnimation(31);
Key.D3: begin Window.SetSize(700, 700); StartAnimation(41);
Key.D4: begin Window.SetSize(800, 800); StartAnimation(51);
Key.Space: if tim <> nil then
if tim.Enabled then tim.Stop else tim.Start;
// перезапуск анимации:
Key.R: if tim <> nil then StartAnimation(size);
Key.Escape: Window.Close;
end;
end;

end;
end;
end;
end;

begin
Window.SetSize(700, 700);
Window.CenterOnScreen;
Window.Title := ' Анимированная спираль Улама';
// запускаем анимацию:
StartAnimation(41);
// обработчик нажатия на клавиши:
OnKeyDown := KeyDown;
Writeln('
Writeln('
Writeln('
Writeln('

Управление:');
1-4 - выбрать размер спирали');
Пробел - пауза/продолжить');
R - перезапуск анимации');
187

Writeln(' Esc - выход');
end.

Спираль крутится, вертится, но не хочет упасть:

Станислав Улам от скуки открыл удивительное свойство простых чисел – располагаться в спирали по диагоналям. Тут, конечно, можно подумать, что в любой таблице будет наблюдаться такое же природное числовое явление. Но это
не так. Следующая программа наглядно показывает, что простые числа не такие уж простые, как это может показаться:

188

Приверженцы самостоятельного, критического мышления могут воспользоваться этой программой, чтобы усовершенствовать её до полного недоразумения:
uses GraphWPF, MathExtensions;
// СРАВНИВАЕМ!
procedure DrawComparison;
begin
Window.SetSize(1200, 600);
Window.CenterOnScreen;
Window.Title := 'Сравниваем спирали: Улама и обычную';
var size := 15;
var cellSize := 20;
//спираль Улама:
var offsetX1 := 50;
var offsetY1 := 50;
var ulamSpiral := new int[size, size];

189

var x := size div 2;
var y := size div 2;
var num := 1;
var dirs := Arr((0,1), (1,0), (0,-1), (-1,0));
var dirIdx := 0;
var steps := 1;
while num <= size*size do begin
ulamSpiral[x, y] := num;
for var i := 1 to 2 do begin
var (dx, dy) := dirs[dirIdx];
for var j := 1 to steps do begin
x += dx;
y += dy;
num += 1;
if num <= size*size then
ulamSpiral[x, y] := num;
end;
dirIdx := (dirIdx + 1) mod 4;
end;
steps += 1;
end;
// обычная спираль:
var offsetX2 := 650;
var offsetY2 := 50;
var regularSpiral := new int[size, size];
num := 1;
for var i := 0 to size - 1 do
for var j := 0 to size - 1 do begin
regularSpiral[i, j] := num;
num += 1;
end;
// рисуем обе спирали:
for var part := 0 to 1 do begin
var offsetX := if part = 0 then offsetX1 else offsetX2;
var offsetY := offsetY1;
var spiral := if part = 0 then ulamSpiral else regularSpiral;
var title := if part = 0 then ' Спираль Улама' else ' Обычная спираль (по
строкам)';
// надписи:
Font.Size := 16;
TextOut(offsetX, offsetY - 30, title);

190

for var i := 0 to size - 1 do
for var j := 0 to size - 1 do begin
var cellX := offsetX + j * cellSize;
var cellY := offsetY + i * cellSize;
var number := spiral[i, j];
// рисуем клетку:
Pen.Color := Colors.LightGray;
Brush.Color := Colors.White;
Rectangle(cellX, cellY, cellSize, cellSize);
// закрашиваем простые числа
if number.IsPrime then begin
Brush.Color := Colors.Blue;
FillRectangle(cellX + 1, cellY + 1, cellSize - 2, cellSize - 2);
end;
// печатаем число:
Brush.Color := Colors.Transparent;
Font.Size := 8;
var textColor := if number.IsPrime then Colors.White else Colors.Black;
DrawText(cellX + 2, cellY + 2, cellSize - 4, cellSize - 4,
number.ToString, textColor);
end;
end;
// надписи:
Font.Size := 12;
TextOut(50, 400, 'В спирали Улама простые числа образуют диагональные линии.');
TextOut(50, 420, 'В обычной спирали распределение случайное.');
// статистика:
var ulamPrimes := 0;
var regularPrimes := 0;
for var i := 0 to size - 1 do
for var j := 0 to size - 1 do begin
if ulamSpiral[i, j].IsPrime then ulamPrimes += 1;
if regularSpiral[i, j].IsPrime then regularPrimes += 1;
end;
TextOut(50, 470, ' Статистика для спирали 15?15:');
TextOut(50, 490, $' Спираль Улама: {ulamPrimes} простых чисел');
TextOut(50, 510, $' Обычная спираль: {regularPrimes} простых чисел');
TextOut(50, 530, ' (количество совпадает, но распределение разное!)');
end;
begin
DrawComparison;
end.

191

192

Проект Эйлер029
Исходный код программы находится в файле Эйлер029.pas.

Задача 29 (Problem 29) называется Distinct Powers.

Различные степени
Рассмотрим все целочисленные комбинации ab для 2 ≤ a ≤ 5 и 2 ≤ b ≤ 5:
22=4, 23=8, 24=16, 25=32
32=9, 33=27, 34=81, 35=243
42=16, 43=64, 44=256, 45=1024
52=25, 53=125, 54=625, 55=3125
Если их расположить в порядке возрастания, исключив повторения, мы получим
следующую последовательность из 15 различных членов:
4, 8, 9, 16, 25, 27, 32, 64, 81, 125, 243, 256, 625, 1024, 3125
Сколько различных членов имеет последовательность ab для 2 ≤ a ≤ 100 и
2 ≤ b ≤ 100?
193

Перебор для чисел a и b невелик, поэтому решаем задачу методом грубой
силы.
Всего существует комбинаций 99 × 99 = 9801 чисел a и b. Решение задачи
покажет, что из них 9183 уникальные, а 618 – повторяются. Например, 8² =
2⁶, 2100 = 450, 1625 = 2100. Поэтому мы поместим все степени в множество,
чтобы в нём остались только единичные экземпляры всех степеней:
// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin
var hs := new HashSet<BigInteger>;

В двух циклах for перебираем все комбинации чисел a и b и добавляем степени в множество:
for var a := 2 to 100 do
for var b := 2 to 100 do
hs.Add(BigInteger.Pow(a, b));

Печатаем число элементов в множестве – и задача решена:
Writeln($' Всего членов в последовательности: {hs.Count}');
// 9183
end;

begin
Writeln(' Project Euler. Problem 29');
WriteLn;
Solve;
end.

На деле это выглядит так:
Project Euler. Problem 29
194

Всего членов в последовательности: 9183

Проект Эйлер030
Исходный код программы находится в файле Эйлер030.pas.

Задача 30 (Problem 30) называется Digit Fifth Powers.

Пятые степени цифр
Удивительно, но существует только три числа, которые могут быть записаны в
виде суммы четвертых степеней их цифр:
1634 = 14 + 64 + 34 + 44
8208 = 84 + 24 + 04 + 84
9474 = 94 + 44 + 74 + 44
1 = 14 не считается, так как это - не сумма.
Сумма этих чисел равна 1634 + 8208 + 9474 = 19316.
Найдите сумму всех чисел, которые могут быть записаны в виде суммы
пятых степеней их цифр.
195

В лучшем случае все числа состоят из девяток, пятые степени которых
равны 9⁵ = 59049.
Но в числах наверняка объявятся и другие цифры. Чтобы не вычислять пятые степени цифр каждого числа, мы сразу поместим их в массив:
uses MathExtensions;

// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin
// вычисляем пятые степени:
var p5 := new int[10];
for var d := 0 to 9 do
p5[d] := int(d ** 5);

Мы вполне разумно можем предположить, что наибольшее число не превосходит 354294:
// сумма:
var sum := 0;
// верхняя граница: 6 х 9⁵ = 354294
for var n := 10 to 354294 do begin
var s := 0;
var temp := n;

Находим сумму пятых степеней цифр текущего числа:
while temp > 0 do begin
s += p5[temp mod 10];
temp := temp div 10;
end;

Если она совпадает самим числом, то добавляем его к результирующей
сумме:
196

if s = n then
sum += n;
end;

Перебор закончен. Печатаем ответ:
Writeln($' Сумма чисел, равных сумме пятых степеней их цифр: {sum}');
// 443839
end;

begin
Writeln(' Project Euler. Problem 30');
WriteLn;
Solve;
end.

Ответ вот такой и правильный:
Project Euler. Problem 30
Сумма чисел, равных сумме пятых степеней их цифр: 443839

Любители математики задолго до нас нашли все числа, пятые степени цифр
которых равны исходным числам:
4150
4151
54748
92727
93084
194979

=
=
=
=
=
=

4⁵
4⁵
5⁵
9⁵
9⁵
1⁵

+
+
+
+
+
+

1⁵
1⁵
4⁵
2⁵
3⁵
9⁵

+
+
+
+
+
+

5⁵
5⁵
7⁵
7⁵
0⁵
4⁵

+
+
+
+
+
+

0⁵
1⁵
4⁵
2⁵
8⁵
9⁵

+
+
+
+

8⁵
7⁵
4⁵
7⁵ + 9⁵

197

Проект Эйлер031
Исходный код программы находится в файле Эйлер031.pas.

Задача 31 (Problem 31) называется Coin Sums.
In the United Kingdom the currency is made up of pound (£) and pence (p). There are
eight coins in general circulation:
1p, 2p, 5p, 10p, 20p, 50p, £1 (100p), and £2 (200p).
It is possible to make £2 in the following way:
1×£1 + 1×50p + 2×20p + 1×5p + 1×2p + 3×1p
How many different ways can £2 be made using any number of coins?

Суммы монет
В Англии валютой являются фунты стерлингов £ и пенсы p, и в обращении есть
восемь монет:
1p, 2p, 5p, 10p, 20p, 50p, £1 (100p) и £2 (200p).
£2 возможно составить следующим образом:
1×£1 + 1×50p + 2×20p + 1×5p + 1×2p + 3×1p
Сколькими разными способами можно составить £2, используя любое количество монет?

Из условия задачи сразу проклёвывается динамическое программирование.
Начинаем динамично программировать:
198

begin
Writeln(' Project Euler. Problem 31');
WriteLn;
Solve;
end.

Кладём все фунтопенсы в массивный кошелёк с целью набрать всеми способами 2 фунта пенсов:
uses MathExtensions;

// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin
// номиналы монет в пенсах:
var coins := |1, 2, 5, 10, 20, 50, 100, 200|;
var target := 200; // 2 фунта = 200 пенсов

Для динамического программирования нужен свой массив, в который мы
сразу отправляем первый способ – как набрать 0 пенсов:
// массив для динамического программирования -->
// ways[i] - количество способов набрать сумму i пенсов:
var ways := new int64[target + 1];
// 1 способ набрать 0 пенсов - не брать монеты:
ways[0] := 1;

Заполняем массив ways монетами, как это принято в динамическом программировании, отталкиваясь от первой записи⬆:
// динамическое программирование:
foreach var coin in coins do begin
for var amount := coin to target do
199

ways[amount] += ways[amount - coin];
end;

В массиве ways индекс target как раз и показывает ответ на задачу:
Writeln($' Количество способов = {ways[target]}');
// 73682
end;

Все способы аккуратно пересчитаны:
Project Euler. Problem 31
Количество способов = 73682

Проект Эйлер032
Исходный код программы находится в файле Эйлер032.pas.

Задача номер 32 (Problem 132) называется Pandigital Products.

Пандигитальные произведения
200

Каждое n-значное число, которое содержит каждую цифру от 1 до n ровно
один раз, будем считать пандигитальным; к примеру, 5-значное число 15234
является пан-цифровым, так как. содержит цифры от 1 до 5.
Произведение 7254 является необычным, поскольку равенство 39 × 186 =
7254, состоящее из множимого, множителя и произведения является панцифровым, то есть. содержит цифры от 1 до 9.
Найдите сумму всех пандигитальных произведений, для которых равенство
"множимое × множитель = произведение" можно записать цифрами от 1 до
9, используя каждую цифру только один раз.
ПОДСКАЗКА: Некоторые произведения можно получить несколькими способами, поэтому убедитесь, что включили их в сумму лишь единожды.
Сегодня наш выбор пал на задачу 32, которая называется Pandigital
Products, или Пандигитальные произведения. С этой задачей справились
уже менее восьмидесяти тысяч участников, то есть задача не столь простая,
как предыдущие.
И тут вы должны непременно внимательно прочитать условие задачи,
чтобы узнать и понять, что такое пандигитальные числа.
В общем случае это числа, которые состоят из разных цифр. По условию
задачи, мы должны найти сумму всех произведений. При этом оба сомножителя и само произведение должны состоять из разных цифр, а именно от
единицы до девятки, но без нуля.
После некоторых сугубых рассуждений мы должны прийти к выводу, что
два сомножителя и произведение должны состоять из девяти разных
цифр. Такое дело может случиться, если первый сомножитель однозначный, а второй – четырёхзначный, или первый сомножитель двузначный, а
второй – трёхзначный. В любом случае произведение состоит из четырёх
разных цифр.
Из однозначных мы должны отбросить единицу, которая порождает произведение с теми же цифрами, что и у второго сомножителя. Остаются числа
2..9. Первый сомножитель может быть также двузначным числом 11..99.
201

Таким образом, в первом цикле for мы изменяем значение первого сомножителя от 2 до 99:
uses MathExtensions;

// СТРОКА СОСТОИТ ИЗ РАЗНЫХ ЦИФР?
function IsPandigital(s : string) : bool;
begin
Result := (s.Length = 9) and
(not s.Contains('0')) and
(s.Distinct().Count() = 9);
end;

// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
// сумма произведений:
var sum: int64 := 0;
// множество для отсеивания повторяющихся произведений:
var hs: HashSet<int> := [];
// решаем задачу -->
// перебираем первые сомножители:
for var n1 := 2 to 99 do begin

Если первый сомножитель однозначный, то второй - четырёхзначный, а
если первый сомножитель двузначный, то второй - трёхзначный. Наименьшее пандигитальное трёхзначное число - 123, а четырёхзначное – 1234.
Пределы изменения и второго сомножителя найдены:
// второй сомножитель:
var n2min := (n1 > 9) ? 123 : 1234;
var n2max := 9999 div n1;
// перебираем вторые сомножители:
for var n2 := n2min to n2max do begin

202

Проще всего провести проверки на пандигитальность не с числами, а со
строками, поэтому преобразуем оба сомножителя и произведение в одну
строку:
// находим произведение:
var product := n1 * n2;
// составляем строку из трёх чисел:
var s := '' + n1 + n2 + product;

Проверку на пандигитальность проводим в функции IsPandigital.
// в строке есть повторы?
if not IsPandigital(s) then continue;

Хотя в задаче требуется найти только сумму чисел, мы распечатываем все
годные произведения на экране:
// для информации печатаем правильные произведения:
Println($' {n1,2} x {n2,4} = {product,5}');

Чтобы проверить, встречалось ли уже очередное произведение раньше, используем множество:
// произведения не должны повторяться:
if hs.Contains(product) then continue;
// добавляем в множество новое произведение:
hs.Add(product);
// добавляем произведение в сумму:
sum += product;
end;
end;
// печатаем ответ:
Println($' Сумма равна: {sum}');
WriteLn;
end;
203

begin
Writeln(' Project Euler. Problem 32');
WriteLn;
Solve();
end.

Запускаем нашу программу во все тяжкие вычисления сумм и произведений.
И она, покладисто урча выдаёт нам все страшные тайны этой эйлеровской
задачи! И даже - сумму всех пандигитальных произведений!
Project Euler. Problem 32
4
4
12
18
27
28
39
42
48

x 1738 =
x 1963 =
x 483 =
x 297 =
x 198 =
x 157 =
x 186 =
x 138 =
x 159 =

6952
7852
5796
5346
5346
4396
7254
5796
7632

Сумма равна: 45228

И отдыхаем, как
Уральские пельмени.

204

Всем известны плоские кукурузные хлопья, которые забавно хрустят на
зубах со времён нашего детства, когда зубы были большими.
А теперь зубы маленькие и хрустят уже безо всяких дополнительных кукурузных хлопьев.
И вот для таких малозубых, но алчных до кукурузных хлопьев людей разнополого возраста, всем никому неизвестная компашка Золотое зерно выпустила Кукурузные хлопцы – для тех, у кого есть перевес недовеса.

205

Проект Эйлер033
Исходный код программы находится в файле Эйлер033.pas.

Задача 33 (Problem 33) называется Digit Cancelling Fractions.

Необычное сокращение дробей
Дробь 49/98 является любопытной, поскольку неопытный математик, пытаясь сократить ее, будет ошибочно полагать, что 49/98 = 4/8, являющееся истиной, получено вычеркиванием девяток.
Дроби вида 30/50 = 3/5 будем считать тривиальными примерами.
Существует ровно 4 нетривиальных примера дробей подобного типа, которые
меньше единицы и содержат двухзначные числа как в числителе, так и в знаменателе.
Пусть произведение этих четырех дробей дано в виде несократимой дроби (числитель и знаменатель дроби не имеют общих сомножителей). Найдите знаменатель этой дроби.

Из условия задачи следует, что мы должны найти все дроби вида ab/cd, в
которых:
• a, b, c, d — цифры (0-9)
206

• a < c (дробь меньше 1)
• b может быть равно d (возможно сокращение)
• Если убрать общую цифру, получится эквивалентная дробь
Вот любопытные дроби, которые нам предстоит найти:
16/64 = 1/4
19/95 = 1/5
26/65 = 2/5
49/98 = 1/2
Как обычно, решение задачи начинается в процедуре Solve:
begin
Writeln(' Project Euler. Problem 33');
WriteLn;
Solve;
end.

Функция IsCuriousFraction проверяет дробь, заданную цифрами:
uses MathExtensions;

// ПРОВЕРЯЕМ ДРОБЬ ВИДА ab/cd
function IsCuriousFraction(a, b, c, d: int): bool;
begin
// избегаем деления на 0:
if (b = 0) or (d = 0) then exit(false);
// тривиальные случаи:
if (a = b) or (c = d) then exit(false);
// числитель:
var originalNumerator := 10*a + b;
// знаменатель:
var originalDenominator := 10*c + d;
// дробь должна быть < 1:
207

if originalNumerator >= originalDenominator then
exit(false);
// дробь:
var originalValue := originalNumerator / originalDenominator;
// пробуем сократить, если есть общая цифра
var simplifiedValue: real;
// сокращаем первую цифру (a и c):
if (a = c) then
simplifiedValue := b / d
// сокращаем a и d:
else if (a = d) then
simplifiedValue := b / c
// сокращаем b и c:
else if (b = c) then
simplifiedValue := a / d
// сокращаем b и d:
else if (b = d) then
simplifiedValue := a / c
// нет общих цифр:
else exit(false);
// проверяем дроби на равенство:
//Result := Abs(originalValue - simplifiedValue) < 1e-10;
Result := originalValue = simplifiedValue;
end;

В процедуре Solve мы ищем дроби, удовлетворяющие условию задачи, и отправляем их на хранение в список curiousFractions:
// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin
// список дробей:
var curiousFractions := new List<(int, int, int, int)>;
// перебираем все возможные дроби ab/cd:
for var a := 1 to 9 do
for var b := 0 to 9 do
for var c := a + 1 to 9 do // a < c, чтобы дробь была < 1
for var d := 0 to 9 do begin
208

if IsCuriousFraction(a, b, c, d) then
curiousFractions.Add((a, b, c, d));
end;

Все дроби найдены. Аккуратно и бережно печатаем их на экране:
Writeln($' Найдено любопытных дробей: ', curiousFractions.Count);
var productNumerator := 1;
var productDenominator := 1;
foreach var (a, b, c, d) in curiousFractions do begin
var num := 10*a + b;
var den := 10*c + d;
var val := num / den;
var s: String;
if a = c then s := $'{b}/{d}'
else if a = d then s := $'{b}/{c}'
else if b = c then s := $'{a}/{d}'
else s := $'{a}/{c}';
Writeln($' {num}/{den} = {s}');
productNumerator *= num;
productDenominator *= den;
end;
// сокращаем произведение:
var gcdValue := Gcd(productNumerator, productDenominator);
var simplifiedNum := productNumerator div gcdValue;
var simplifiedDen := productDenominator div gcdValue;
Writeln;
Writeln($' Произведение всех дробей = {productNumerator}/{productDenominator}');
Writeln($' После сокращения: {simplifiedNum}/{simplifiedDen}');
Writeln($' Знаменатель дроби = {simplifiedDen}');
// 100
end;

Под барабанную дробь дробно дробим ответ:
209

Project Euler. Problem 33
Найдено
16/64 =
19/95 =
26/65 =
49/98 =

любопытных дробей: 4
1/4
1/5
2/5
4/8

Произведение всех дробей = 387296/38729600
После сокращения: 1/100
Знаменатель дроби = 100

Проект Эйлер034
Исходный код программы находится в файле Эйлер034.pas.

Задача 34 (Problem 34) называется Digit Factorials.

Факториалы цифр
145 является любопытным числом, поскольку 1! + 4! + 5! = 1 + 24 + 120 = 145.
Найдите сумму всех чисел, каждое из которых равно сумме факториалов своих
цифр.
Примечание: поскольку 1! = 1 и 2! = 2 не являются суммами, учитывать их не
следует.
210

Для больших чисел сумма факториалов цифр не успевает за ростом самих
чисел, поэтому это редкое свойство имеют всего 4 числа в десятичной системе.
1 = 1!
2 = 2!
145 = 1! + 4! + 5! = 1 + 24 + 120 = 145
40585 = 4! + 0! + 5! + 8! + 5! = 24 + 1 + 120 + 40320 + 120 = 40585

По условию задачи, первые два числа использовать нельзя, а второй дуэт из
квартета даёт сумму:
145 + 40585 = 40730

Это и есть ответ на задачу, которую нам предстоит решить.
В процедуре Solve сразу заполняем список fact факториалами цифр 0..9:
uses MathExtensions;

// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin
// факториалы цифр:
var fact := GetFactorialN(10).ToList;

Для этого я добавил в модуль MathExtensions новый генератор факториалов:
function GetFactorialN(num: int): sequence of Integer;
begin
yield 1;
var n := 1;
foreach var i in Range(1, num) do begin
n := i * n;
yield n;
end;
end;
211

Наука математики говорит, что достаточно искать числа в диапазоне от 10
до 2540160. Нехотя согласимся, а если что-то пойдёт супротив науки, то
расширим диапазон границ поиска вправо до упора:
// сумма:
var sum := 0;
// верхняя граница: 7 х 9! = 2540160:
for var n := 10 to 2540160 do begin

Максимальный вклад одной цифры: 9! = 362880
Для n-значного числа: максимальная сумма = n × 362880
Находим, когда n × 362880 < 10ⁿ⁻¹:
n=7: 7 × 362880 = 2,540,160 < 10,000,000
n=8: 8 × 362880 = 2,903,040 < 100,000,000
Практически достаточно искать до 10⁶
В цикле for вычисляем сумму факториалов s очередного числа n:
var s := int64(0);
var temp := n;
while temp > 0 do begin
s += fact[temp mod 10];
temp := temp div 10;
end;

Если сумма факториалов цифр равна самому числу, то добавляем его к результирующей сумме:
if s = n then
sum += n;
end;

Задача решена. Печатаем ответ:
212

Writeln($' Сумма чисел, равных сумме факториалов их цифр, = {sum}');
// 40730
end;

begin
Writeln(' Project Euler. Problem 34');
WriteLn;
Solve;
end.

Как говорил Винни, сходится и хорошо выходится:
Project Euler. Problem 34
Сумма чисел, равных сумме факториалов их цифр, = 40730

213

Проект Эйлер035
Исходный код программы находится в файле Эйлер035.pas.

Задача 35 (Problem 35) называется Circular Primes.

Круговые простые числа
Число 197 называется круговым простым числом, потому что все перестановки
его цифр с конца в начало являются простыми числами: 197, 719 и 971.
Существует тринадцать таких простых чисел меньше 100: 2, 3, 5, 7, 11, 13, 17, 31,
37, 71, 73, 79 и 97.
Сколько существует круговых простых чисел меньше миллиона?

Число называется круговым простым, если все числа, полученные циклическим сдвигом его цифр, также являются простыми. Например:
197 → 971 → 719 → все простые.
Однозначные простые числа - 2, 3, 5, 7 - формально круговые.
Многозначные простые числа не могут содержать цифры 0, 2, 4, 5, 6, 8.
При повороте такая цифра окажется последней, и число разделится на 2 или
5.
Поэтому многозначные простые числа состоят только из цифр 1, 3, 7, 9.
Начинаем решать задачу приступом:
214

begin
Writeln(' Project Euler. Problem 35');
WriteLn;
Solve;
end.

В процедуре Solve считаем простые круговые числа и отправляем их в список circularPrimes:
// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin
var limit := 1_000_000;
var count := 0;
var circularPrimes := new List<int>;

Для проверки чисел из заданного диапазона на простоту и «круглость» пишем 2 вспомогательные функции:
uses MathExtensions;

function GetRotations(n: int): array of int;
begin
var s := n.ToString;
SetLength(Result, s.Length);
for var i := 0 to s.Length - 1 do begin
var rotated := s.Substring(i) + s.Substring(0, i);
Result[i] := StrToInt(rotated);
end;
end;

function IsCircularPrime(n: int): bool;
begin
var rotations := GetRotations(n);
foreach var rot in rotations do
215

if not (rot.IsPrime) then
exit(false);
Result := true;
end;

Первая функция циклически переставляет цифры в числе, а вторая проверяет, получилось при этом простое число.
С помощью этих функций мы проверяем все числа в заданном диапазоне,
считаем подходящие и запоминаем их в списке circularPrimes:
// проверяем все числа:
for var n := 2 to limit - 1 do begin
if IsCircularPrime(n) then begin
count += 1;
circularPrimes.Add(n);
end;
end;

Для интереса любопытства распечатываем все круговые простые числа и
ответ на задачу:
// печатаем найденные числа:
foreach var i in circularPrimes do begin
Writeln(i:6);
end;
Writeln;
Writeln($' Всего круговых простых чисел < {limit}: {count}');
// 55
end;

Вот полный отчёт о проделанной работе:
Project Euler. Problem 35

216

2
3
5
7

11
13
17
31
37
71
73
79
97

113
131
197
199
311
337
373
719
733
919
971
991

1193
1931
3119
3779
7793
7937
9311
9377

11939
19391
19937
37199
39119
71993
91193
93719
93911
99371

193939
199933
319993
331999
391939
393919
919393
933199
939193
939391
993319
999331

Всего круговых простых чисел < 1000000: 55

Если из прихоти поискать круговые простые числа до 10 миллионов, то нет.

Проект Эйлер036
Исходный код программы находится в файле Эйлер036.pas.

Задача 36 (Problem 36) называется Double-base Palindromes.

Двухосновные палиндромы
217

Десятичное число 585 = 10010010012 (в двоичной системе), является палиндромом по обоим основаниям.
Найдите сумму всех чисел меньше миллиона, являющихся палиндромами по основаниям 10 и 2.
(Пожалуйста, обратите внимание на то, что палиндромы не могут начинаться с
нуля ни в одном из оснований).

Число, которое является палиндромом как в десятичной, так и в двоичной
системе счисления, называется двухосновным палиндромом. Например:
Десятичное | Двоичное
-----------|---------1
= 1
3
= 11
5
= 101
7
= 111
9
= 1001
33
= 100001
99
= 1100011
313
= 100111001
585
= 1001001001
Не раздвояясь и не размениваясь по мелочам, приступаем к решению задачи:
begin
Writeln(' Project Euler. Problem 36');
WriteLn;
Solve;
end.

В модуле MathExtensions на этот случай у нас есть готовый метод расширения для целых чисел IsPalindrome:
218

function IsPalindrome(Self: int): bool; extensionmethod;
begin
// избавляемся от чисел, заканчивающихся на нуль:
if ((self <> 0) and (self mod 10 = 0)) then
exit(false);
var rev := 0;
var num := self;
while (num >= rev) do begin
rev := 10 * rev + num mod 10;
if (num = rev) then exit(true);
num := num div 10;
if (num = rev) then exit(true);
end;
Result := false;
end;

А для бинарных чисел добавляем функцию IsBinaryPalindrome в новую
программу:
uses MathExtensions;

function IsBinaryPalindrome(n: int): bool;
begin
// конвертируем число в двоичную строку без ведущих нулей:
var binary := '';
var temp := n;
while temp > 0 do begin
binary := (temp mod 2).ToString + binary;
temp := temp div 2;
end;
// проверяем, является ли двоичная строка палиндромом:
var len := binary.Length;
for var i := 1 to len div 2 do
if binary[i] <> binary[len - i + 1] then
exit(false);
Result := true;
end;

219

В процедуре Solve перебираем все числа в заданном диапазоне:
// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin
var limit := 1_000_000;
var sum := 0;
var numbersFound := new List<int>;
// проверяем все числа от 1 до limit-1
for var n := 1 to limit - 1 do begin

Если очередное число показало себя в двух палиндромных ипостасях: десятичной и двоичной, то мы добавляем его к результирующей сумме и запоминаем в списке:
if n.IsPalindrome and IsBinaryPalindrome(n) then begin
sum += n;
numbersFound.Add(n);
end;
end;

Все числа окончательно посчитаны:
Writeln($' Найдено чисел: {numbersFound.Count}');
Writeln;

А вот и сами числа:
// печатаем все найденные числа:
foreach var n in numbersFound do begin
// двоичное представление:
var binary := '';
var temp := n;
while temp > 0 do begin
binary := (temp mod 2).ToString + binary;
temp := temp div 2;
220

end;
Writeln($' {n,6} (десятичное) = {binary.PadLeft(20)} (двоичное)');
end;
Writeln;
Writeln($' Сумма всех чисел = {sum}');
// 872187
end;

Наглядно решение задачи выглядит так:
Project Euler. Problem 36
Найдено чисел: 19
1
3
5
7
9
33
99
313
585
717
7447
9009
15351
32223
39993
53235
53835
73737
585585

(десятичное)
(десятичное)
(десятичное)
(десятичное)
(десятичное)
(десятичное)
(десятичное)
(десятичное)
(десятичное)
(десятичное)
(десятичное)
(десятичное)
(десятичное)
(десятичное)
(десятичное)
(десятичное)
(десятичное)
(десятичное)
(десятичное)

=
1
=
11
=
101
=
111
=
1001
=
100001
=
1100011
=
100111001
=
1001001001
=
1011001101
=
1110100010111
=
10001100110001
=
11101111110111
=
111110111011111
=
1001110000111001
=
1100111111110011
=
1101001001001011
=
10010000000001001
= 10001110111101110001

(двоичное)
(двоичное)
(двоичное)
(двоичное)
(двоичное)
(двоичное)
(двоичное)
(двоичное)
(двоичное)
(двоичное)
(двоичное)
(двоичное)
(двоичное)
(двоичное)
(двоичное)
(двоичное)
(двоичное)
(двоичное)
(двоичное)

Сумма всех чисел = 872187

221

Проект Эйлер037
Исходный код программы находится в файле Эйлер037.pas.

Задача 37 (Problem 37) называется Truncatable Primes.

Усекаемые простые числа
Число 3797 обладает интересным свойством. Будучи само по себе простым
числом, из него можно последовательно выбрасывать цифры слева направо,
число же при этом остается простым на каждом этапе: 3797, 797, 97, 7. Точно
таким же способом можно выбрасывать цифры справа налево: 3797, 379, 37, 3.
Найдите сумму единственных одиннадцати простых чисел, из которых можно
выбрасывать цифры как справа налево, так и слева направо, но числа при этом
остаются простыми.
ПРИМЕЧАНИЕ: числа 2, 3, 5 и 7 таковыми не считаются.

Простое число называется усекаемым, если:
При удалении цифр справа налево все полученные числа простые
При удалении цифр слева направо все полученные числа простые
Например, число 3797 усекаемое:
Правое усечение: 3797 → 379 → 37 → 3 (все простые)
Левое усечение: 3797 → 797 → 97 → 7 (все простые)
222

Вот все 11 усекаемых простых чисел:
23, 37, 53, 73, 313, 317, 373, 797, 3137, 3797, 739397
Глядя или не глядя на них, мы должны прийти к таким выводам:
Только цифры 2, 3, 5, 7 могут начинать и заканчивать искомые числа, так
как однозначные версии должны быть простыми.
Также допускаются нечётные цифры (без пятёрки): 1, 3, 7, 9.
Цифры 0, 4, 6, 8 исключаем.
Прежде чем начать решение задачи в процедуре Solve, пишем функцию
IsTruncatablePrime для проверки числа на простоту и усекаемость:
begin
Writeln(' Project Euler. Problem 37');
Solve;
end.

Тысячу пардонов за каламбур, но проще всего проверить число на простоту:
uses MathExtensions;

// ПРОВЕРЯЕМ ЗАДАННОЕ ЧИСЛО НА УСЕКАЕМОСТЬ
function IsTruncatablePrime(n: integer): boolean;
begin
// число не простое:
if not (n.IsPrime) then exit(false);

Туда же вслед отправляем однозначные числа:
var s := n.ToString;
var len := s.Length;
223

// однозначное число:
if len < 2 then exit(false);

Проверка числа на усекаемость тоже несложна,
если усечь принципы проверки чисел туда и обратно:
// усекаем число справа налево
// (удаляем последнюю цифру):
var temp := n;
while temp > 9 do begin
temp := temp div 10;
if not (temp.IsPrime) then exit(false);
end;
// усекаем число слева направо
// (удаляем первую цифру)
temp := n;
while temp > 9 do begin
var power := 1;
while power * 10 <= temp do
power *= 10;
temp := temp mod power;
if not (temp.IsPrime) then exit(false);
end;
Result := true;
end;

А вот теперь вплотную можно заняться решением задачи!
Самое важное знание для этого – чисел всего 11, поэтому нам не нужно задумываться о диапазоне поиска чисел.
// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin
var count := 0;
var sum := 0;
var numbersFound := new List<integer>;
224

// первые 4 простых числа пропускаем:
var n := 11;
// всего существует 11 таких чисел:
while count < 11 do begin
// нашли:
if IsTruncatablePrime(n) then begin
count += 1;
sum += n;
numbersFound.Add(n);
Writeln;
Writeln($' Нашли усекаемое простое число {count,2}: {n}');
// процесс усечения найденного числа&
Write(' Усечение справа: ');
var temp := n;
while temp > 0 do begin
Write(temp);
temp := temp div 10;
if temp > 0 then Write(' → ');
end;
Writeln;
Write(' Усечение слева: ');
temp := n;
while temp > 0 do begin
Write(temp);
var power := 1;
while power * 10 <= temp do
power *= 10;
temp := temp mod power;
if temp > 0 then Write(' → ');
end;
Writeln;
end;
// считаем найдёнышей:
n += 1;
end;
Writeln;
Writeln(' Всего найдено усекаемых простых чисел: ', count);
Writeln;
Write(' Числа: ');
foreach var num in numbersFound do
Write(num, ' ');
Writeln;
225

Writeln(' Сумма всех усекаемых простых чисел =', sum);
// 748317
end;

С помощью функции IsTruncatablePrime мы без заботы и труда выявим на
свет эти числа. А сэкономленные силы и энергию направим на красивый
вывод решения на экран.
И вот он, исчерпывающий ответ на задачу:
Project Euler. Problem 37
Нашли усекаемое простое число
Усечение справа: 23 → 2
Усечение слева: 23 → 3

1: 23

Нашли усекаемое простое число
Усечение справа: 37 → 3
Усечение слева: 37 → 7

2: 37

Нашли усекаемое простое число
Усечение справа: 53 → 5
Усечение слева: 53 → 3

3: 53

Нашли усекаемое простое число
Усечение справа: 73 → 7
Усечение слева: 73 → 3

4: 73

Нашли усекаемое простое число 5: 313
Усечение справа: 313 → 31 → 3
Усечение слева: 313 → 13 → 3
Нашли усекаемое простое число 6: 317
Усечение справа: 317 → 31 → 3
Усечение слева: 317 → 17 → 7
Нашли усекаемое простое число 7: 373
Усечение справа: 373 → 37 → 3
Усечение слева: 373 → 73 → 3
226

Нашли усекаемое простое число 8: 797
Усечение справа: 797 → 79 → 7
Усечение слева: 797 → 97 → 7
Нашли усекаемое простое число 9: 3137
Усечение справа: 3137 → 313 → 31 → 3
Усечение слева: 3137 → 137 → 37 → 7
Нашли усекаемое простое число 10: 3797
Усечение справа: 3797 → 379 → 37 → 3
Усечение слева: 3797 → 797 → 97 → 7
Нашли усекаемое простое число 11: 739397
Усечение справа: 739397 → 73939 → 7393 → 739 → 73 → 7
Усечение слева: 739397 → 39397 → 9397 → 397 → 97 → 7
Всего найдено усекаемых простых чисел: 11
Числа: 23 37 53 73 313 317 373 797 3137 3797 739397
Сумма всех усекаемых простых чисел =748317

Проект Эйлер038
Исходный код программы находится в файле Эйлер038.pas.

Задача номер 38 (Problem 38) называется Pandigital multiples.
Пандигитальные сомножители
Возьмем число 192 и умножим его по очереди на 1, 2 и 3:
192 × 1 = 192
192 × 2 = 384
192 × 3 = 576
227

Объединяя все три произведения, получим девятизначное число 192384576
из цифр от 1 до 9 (пан-цифровое число). Будем называть число 192384576
объединенным произведением 192 и (1,2,3)
Таким же образом можно начать с числа 9 и по очереди умножать его на 1,
2, 3, 4 и 5, что в итоге дает пан-цифровое число 918273645, являющееся
объединенным произведением 9 и (1,2,3,4,5).
Какое самое большое девятизначное пан-цифровое число можно образовать как объединенное произведение целого числа и (1,2, ... , n), где n > 1?
Продолжаем бить в одну точку и долбить вдрызг пандигитальные числа.
На этот раз – в задаче 38 из Проекта Эйлера, которая называется Pandigital
multiples, или Пандигитальные сомножители. Её решили менее 70 тысяч
участников проекта, так что эта задача не всем по зубам.
Задача 38 сильно напоминает и смахивает на задачу 32 Пандигитальные
произведения, что нам, конечно, на руку и по плечу. Тем не менее внимательно читаем и вчитываемся в условие задачи, чтобы наметить пути стремительного наступления на неё по всему фронту.
Легко убедиться, что первым сомножителем может быть число 1-9999. А
второй сомножитель изменяется в диапазоне 1..9:
Отмечаем также для себя мотанием на ус, что произведения нужно записывать в одну строку, и в ней должны быть все цифры по одному разу – за исключением нуля. Для проверки строки на пандигитальность пишем функцию IsPandigital, а дальше всё пойдёт как российский сыр по сливочному
маслу!
uses MathExtensions;

// СТРОКА СОСТОИТ ИЗ РАЗНЫХ ЦИФР?
function IsPandigital(s : string) : bool;
begin
Result := (s.Length = 9) and
(s.All(c -> c <> '0')) and
(s.Distinct().Count() = 9);
228

end;

// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin

Для выдачи ответа на задачу запоминаем наибольшее число в переменной
maxnum:
// наибольшее число:
var maxnum: int64 := 0;

В цикле for перебираем все возможные первые сомножители:
// решаем задачу -->
// перебираем первые сомножители:
for var i := 1 to 9999 do begin
// строка для сложения произведений:
var str := String.Empty;

Вторые сомножители перебираем в цикле while, начиная с единицы. По
условию задачи, для каждого первого сомножителя находим произведения
со вторыми сомножителями и добавляем их в строку. Если очередное произведение слишком удлиняет строку, значит, её пора проверять:
// второй сомножитель:
var n := 1;
// последовательно складываем произведения, пока
// в строке меньше девяти цифр:
while (str.Length < 9) do begin
str += i * n;
n += 1;
end;

229

Если проверка строки в функции IsPandigital прошла успешно, то конвертируем строку в число. Самый простой способ для этого – воспользоваться
методом ToInt64 класса Convert:
// нашли пандигитальное число:
if IsPandigital(str) then begin
var num := Convert.ToInt64(str);

Если новое произведение больше текущего, то отмечаем его запоминанием
в переменной maxnum:
// запоминаем, если оно больше текущего значения:
if (num > maxnum) then
maxnum := num;

По ходу дела и ради интереса печатаем все текущие рекорды:
// печатаем промежуточные результаты:
Println($' {i,4}, {n-1} → {str}');
end;
end;

Перебрав все возможные произведения, отчитываемся перед собой полным
отчётом на экране:
// печатаем ответ:
Println($' Наибольшее число = {maxnum}');
WriteLn;
end;

begin
Writeln(' Project Euler. Problem 38');
WriteLn;
Solve();
230

end.

Однажды покумекав, мы можем докумекаться, что можно сравнивать
строки, а не числа, поэтому совсем необязательно конвертировать длинную строку в число:
procedure Solve2();
begin
// наибольшее число:
var maxstr := String.Empty;
// решаем задачу -->
// перебираем первые сомножители:
for var i := 1 to 9999 do begin
// строка для сложения произведений:
var str := String.Empty;
// второй сомножитель:
var n := 1;
// последовательно складываем произведения, пока
// в строке меньше девяти цифр:
while (str.Length < 9) do begin
str += i * n;
n += 1;
end;
// нашли пандигитальное число:
if IsPandigital(str) then begin
if (str.CompareTo(maxstr) > 0) then
maxstr := str;
// печатаем промежуточные результаты:
Println($' {i,4}, {n-1} → {str}');
end;
end;
// печатаем ответ:
Println($' Наибольшее число = {maxstr}');
WriteLn;
end;

В коде кода выпускаем нашу программу на борьбу с иностранными и странными пандигитальными числами.
231

И как мы воочию видим, чтобы убедиться: гораздо выгоднее иметь дело с
большими числами, чтобы преумножать их ещё пуще для своей личной и
наличной выгоды.

232

Проект Эйлер043
Исходный код программы находится в файле Эйлер043.pas.

Задача номер 43 (Problem 43) называется Sub-string Divisibility.
Делимость подстрок
Число 1406357289, является пан-цифровым, поскольку оно состоит из цифр
от 0 до 9 в определенном порядке. Помимо этого, оно также обладает интересным свойством делимости подстрок.
Пусть d1 будет 1-й цифрой, d2 будет 2-й цифрой, и так далее. В таком случае,
можно заметить следующее:
• d2d3d4=406 делится на 2 без остатка
• d3d4d5=063 делится на 3 без остатка
• d4d5d6=635 делится на 5 без остатка
• d5d6d7=357 делится на 7 без остатка
• d6d7d8=572 делится на 11 без остатка
• d7d8d9=728 делится на 13 без остатка
• d8d9d10=289 делится на 17 без остатка
Найдите сумму всех пандигитальных чисел из цифр от 0 до 9, обладающих данным свойством.
Тема пандигитальных чисел ещё далеко не исчерпана и не вычерпана до
дна. И сегодня мы снова глубоко зачерпнём новые пандигитальные числа
из задачи 43 Проекта Эйлера, которая называется Sub-string Divisibility,
или Делимость подстрок. Её решили ещё меньше участников проекта, чем
предыдущие. И это не случайно!
При внимательном и усердном чтении задачи мы можем извлечь важные
для её решения упрямые факты.
Нам нужны для препарирования и последующего исследования все пандигитальные числа, состоящие из десяти цифр.
233

Из этих чисел мы должны последовательно извлекать все трёхзначные
числа, исключая при этом первую цифру пандигитального числа, и проверять их опять же последовательно на простые делители 2,3,5,7,11,13,17.
Эти операции проще и естественнее выполнять со строками, поэтому мы
будем сразу генерировать строки из пандигитальных чисел.
Но, чтобы найти сумму всех затребованных чисел, нам нужны сами числа,
поэтому придётся строки конвертировать в числа, что не очень сложно.
Всё это мы плотно мотаем себе на оба уса, потому что сами с усами. И пора
крутить усы – они у нас не для красы!
Генератор перестановок – это комбинаторная причуда, которую мы возьмём из паскаля в готовом виде. В этой задаче мы не должны дополнительно
обременять себя изобретением комбинаторных велосипедов.
Генератор перестановок получает строку с полным набором цифр и переставляет их как ему заблагорассудится и душе его угодно, а мы получим все
перестановки цифр в виде чисел-строк.
Получив очередную пандигитальную строку, мы отправляем её на проверку в функцию Uslovie. В этой функции мы последовательно извлекаем
подстроки из тройки цифр, начиная со второй (её индекс равен единице),
составляем из них трёхзначное число и делим его на соответствующее простое число из массива primeDivisors. И только если все тройки чисел
успешно и послушно разделятся на свои делители, функция вернёт true. А
иначе нам удачи не видать, а видать только false.
Пригодную для дела строку превращаем в число и добавляем в переменную
res.
Теперь мы можем распечатать все пандигитальные числа, которые не отторгаются условием задачи.
А также легко вычислить сумму этих чисел, чтобы отчеканить наш ответ на
пандигитальный челлендж!

234

Если вы хотите яснее уяснить себе, что такое челлендж, то посмотрите номер Солдатский челлендж из шоу Уральских пельменей
Мятый элемент.

И тут уж делать нечего, кроме как натравить и науськать нашу программу
на пандигитальные числа!
uses MathExtensions;
// ПРОВЕРЯЕМ УСЛОВИЕ ЗАДАЧИ
function Uslovie(num: string): bool;
begin
// простые делители:
var primeDivisors := |2, 3, 5, 7, 11, 13, 17|;
// проверяем для всех делителей:
for var i := 0 to primeDivisors.Length - 1 do begin
var snum3 := num.Slice(i + 1, 1, 3);
var num3 := snum3.ToInteger;
// не делится на очередное простое число:
if num3 mod primeDivisors[i] <> 0 then
exit(false);
235

end;
// число выдержало все проверки:
Result := true;
end;

// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
// решаем задачу -->
var res := '0123456789'.Permutations
// генерируем перестановки
.Where(Uslovie)
// отбираем строки, удовлетворяющие условию
.Select(int64.Parse); // конвертируем строку в
число
// печатаем все числа,
// для которых выполняется условие задачи:
foreach var n in res do
Println($' Число = {n}');
// находим сумму этих чисел:
var sum := res.Sum();
// печатаем ответ:
Println($' Сумма = {sum}');
WriteLn;
end;

begin
Writeln(' Project Euler. Problem 43');
WriteLn;
Solve();
end.

И она бодро и хватко наловила полный улов пандигитальных чисел и
быстро сложила их в сумку и в сумму. Пандигитальный трофей оказался не
маленьким, а вот такенным здоровенным!
Project Euler. Problem 43
236

Число
Число
Число
Число
Число
Число
Сумма

=
=
=
=
=
=
=

1406357289
1430952867
1460357289
4106357289
4130952867
4160357289
16695334890

Как наставлял нас в школе на ум Александр Сергеевич Грибоедов в комедии
"Горе от ума", Шумим, братец, шумим.
Из этого следует, что горе от ума порождает ненужный и даже вредный
шум. Это особенно верно для убытка здоровья, если речь заходит о техническом и научном уме, от которого и много шума, и много горя.

237

Проект Эйлер041
Исходный код программы находится в файле Эйлер041.pas.

Задача номер 41 (Problem 41) называется Pandigital Prime.
Пандигитальное простое число
Будем считать n-значное число пан-цифровым, если каждая из цифр от 1 до
n используется в нем ровно один раз. К примеру, 2143 является 4-значным
пан-цифровым числом, а также простым числом.
Какое существует наибольшее n-значное пан-цифровое простое число?
Вы будете смеяться до упаду, но и сегодня мы будем решать проект-эйлеровскую задачу номер 41 про пандигитальные числа.
Как следует из условия задачи, Эйлер предлагает нам отыскать наибольшее простое пандигитальное число.
Однозначное число 1 пандигитальное, но не простое. Легко проверить, что
на тройку не делятся только четырёх- и семизначные пандигитальные
числа (вспомните, если сможете, признак делимости на 3). Все остальные
пандигитальные числа не простые, а составные как раз по этой причине.
Вполне разумно и логично начать поиски с семизначных чисел. А уж ежели
не повезёт, то вернуться вспять к четырёхзначным, среди которых безусловно есть хотя бы одно подходящее.
Генератор перестановок для строк у нас уже имеется в полном достатке и
в готовом виде. Мы опробовали его в боевой обстановке, и он показал себя
с лучшей стороны и вёл себя героически.
Также в нашей математической копилке есть метод расширения IsPrime
для проверки чисел на простоту. Да с такой подготовкой мы осилим любого
проектанта Эйлера. Кстати говоря, эту задачу решили более 75 тысяч
238

человек, так что это не самая большая загвоздка для математического гвоздодёра.
С генератором перестановок вы уже близко познакомились в предыдущих
проектах, посему идём дальше.
В строку digits записываем всю премудрую цифирь, необходимую для производства семизначных пандигитальных чисел:
uses MathExtensions;
// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
// цифры:
var digits := '7654321';
//var digits = '4321';

Важная переменная maxPrime хранит наибольшее пандигитальное простое число. Нуль служит сигналом, что мы не нашли нужного числа.
// наибольшее число:
var maxPrime: int64 := 0;

В цикле foreach мы последовательно получаем все строковые перестановки цифр 1-7.
// решаем задачу:
foreach var perm in digits.Permutations do begin

Конвертируем строку в число:
// конвертируем строку в число:
var num := perm.ToInteger;

239

Нас по долгу службы интересуют только числа, которые больше текущего
значения переменной maxPrime, но обязательно простые:
// проверяем условие задачи:
if (num > maxPrime) and (num.IsPrime) then
maxPrime := num;
end;

Закончив и покончив со всеми семизначными пандигитальными простыми
числами, мы печатаем самое крупное из них для отчёта перед собой и на
экране:
// печатаем ответ:
if (maxPrime = 0) then
Println($' Решений нет!')
else
Println($' Наибольшее пандигитальное простое число = {maxPrime}');
writeln;
end;

begin
Writeln(' Project Euler. Problem 41');
WriteLn;
Solve();
end.

Запускаем программу в математическое пространство.
После успешного выхода программы на пандигитальную орбиту она сообщает нам свысока ответ на эйлеровскую задачу. Ответ верный, математикой клянусь!
Project Euler. Problem 41
Наибольшее пандигитальное простое число = 7652413
240

Так как ноль не изменяет сумму цифр числа, то мы можем поискать пандигитальное число с нулём внутри себя:
Project Euler. Problem 41
Наибольшее пандигитальное простое число = 76540231

Учимся вдогонку смехотворно расширять свой словарный запас наружу.
Проще всего глумиться над словарным запасом, просто подменяя одну или
несколько буквой другими так, чтобы придать слову новое, шуточное значение.
Например, к примеру всем известно слово домочадцы. Это устаревшее
название членов семьи, которые толпятся и толкутся без дела в одном доме.
Но давайте заменим букву О буквой Ы, чтобы получить слово с новым смыслом – дЫмочадцы. Это уже такие членовредительные члены семьи, которые
чадят дымом, когда женщины занимаются домашним хозяйством.

241

Проект Эйлер104
Исходный код программы находится в файле Эйлер104.pas.

Задача номер 104 (Problem 104) называется Pandigital Fibonacci Ends.
Пандигитальные концы чисел Фибоначчи
Последовательность Фибоначчи определяется следующим рекуррентным
выражением:
Fn = Fn−1 + Fn−2, где F1 = 1 и F2 = 1.
Оказывается, что число F541, состоящее из 113 цифр, является первым числом Фибоначчи, у которого последние девять цифр образуют пандигитальное число с цифрами от 1 до 9 (оно содержит все цифры от 1 до 9, но не обязательно в порядке возрастания). А число F2749, состоящее из 575 цифр, является первым числом Фибоначчи, у которого первые девять цифр образуют
пандигитальное число с цифрами от 1 до 9.
Известно, что число Fk является первым числом Фибоначчи, у которого как
первые, так и последние девять цифр образуют пандигиатльные числа.
Найдите k.
Ретивые математики-селекционеры скрестили пандигитальные числа с
простыми. Произошло это в задаче номер 41 из Проекта Эйлера. Легко догадаться и смекнуть, что на этом они не остановились и не успокоили свои
трудовые и научные порывы к скрещиванию чисел.
Нет, они бодрым шагом пошли дальше вперёд, чтобы очаровать нас новой
гибридохимерой – пандигитальными числами Фибоначчи уже в задаче номер 104.
Тут следует отметить, что уже из условия задачи ясно и однозначно следует, что в природе нет по-настоящему цельных, без разрывов и надрывов
пандигитальных чисел Фибоначчи.
242

Однако есть числа Фибоначчи, которые начинаются или заканчиваются на пандигитальные
числа с цифрами 1..9. Они ну очень большие –
как раки, которые были вчера по 5 рублей.
Совершенно очевидно, что число Фибоначчи,
которое имеет пандигитальные голову и хвост,
ещё того больше. И даже гораздо больше. Но для нас важно, что такое число
есть и существует. Его-то мы и должны найти и отыскать, как это уже
успешно сделали более 18 тысяч человек.
Избегая напрочь хитрых математических приёмов, мы отыщем ответ простым перебором среди огромных чисел типа BigInteger. Это потребует от
нас некоторого терпения и прочего терпежа. Но оно того стóит.
Пишем новую функцию IsPandigital для проверки чисел на пандигитальность:
uses MathExtensions;
// ПРОВЕРЯЕМ ЧИСЛО НА ПАНДИГИТАЛЬНОСТЬ
function IsPandigital(n: int64): bool;
begin
var s := n.ToString();
Result := s.OrderBy(c -> c).SequenceEqual('123456789');
end;

Первые два числа Фибоначчи сразу и всем известны. Все последующие мы
генерируем на лету́ в бесконечном цикле while, в котором также считаем
номера чисел Фибоначчи, чтобы дать потом наш достойный ответ господину Эйлеру:
// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
// первые числа Фибоначчи:
var f1: BigInteger := 1;
var f2: BigInteger := 1;
243

// номер текущего числа Фибоначчи:
var k := 2;
// решаем задачу:
while true do begin
k += 1;
// текущее число Фибоначчи:
var current := f1 + f2;
(f2, f1) := (f1, current);

Последние 9 цифр текущего числа Фибоначчи легко найти как результат
от деления по модулю на число с девятью нулями.
// проверяем последние 9 цифр:
var last9 := current mod 1_000_000_000;

Весьма желательно, чтобы хвост оказался пандигитальным.
if not IsPandigital(int64(last9)) then
continue;

Оторвать голову числу Фибоначчи сложнее, поэтому мы здесь слегка схитрим и обманем себя, превратив число в строку. От строки мы отрежем первые 9 символов, которые снова превратим в число, чтобы проверить его на
пандигитальность:
var fs9 := fs.Substring(0, 9);
var first9 := int.Parse(fs9);
if not IsPandigital(first9) then
continue;

Не рано, но и не поздно мы получим номер числа Фибоначчи, которое как
раз вовсю годится под условие задачи. Тут нам ура, чепчики и победоносный ответ на экране:
244

// печатаем ответ:
Println($' k = {k}');
writeln;
break;
end;
end;
begin
Writeln(' Project Euler. Problem 104');
WriteLn;
Solve();
end.

Запускаем программу.
После слегка томительного и утомительного ожидания мы получим совсем
немаленький номер числа Фибоначчи, который пандигитальный с обоих
концов. А вот кто придумал эту задачу, мы так и не узнали.
Project Euler. Problem 104
k = 329468

245

Чтобы подняться над собой в чине и стать ближе к деньгам, нужно корячиться наверх, преодолевая препятствия. Но в отличие от альпинистов, карьеристы прокладывают себе путь наверх не только с помощью ног и рук,
но – и преимущественно – угодливого языка, которым следует владеть в совершенстве, иначе никак невозможно подняться по скользкой и опасной карьерной ЛЕСТЬНИЦЕ.

246

Проект Эйлер142
Исходный код программы находится в файле Эйлер142.pas.

Задача номер 142 (Problem 142) называется Perfect Square Collection.
Find the smallest x + y + z with integers (x > y > z > 0) such that x + y, x – y, x + z, x –
z, y + z, y – z are all perfect squares.
Коллекция полных квадратов
Найдите тройку натуральных чисел x, y и z таких, что выражения x + y,
x - y, x + z, x - z, y + z, y – z представляют собой квадраты натуральных чисел.
При этом сумма чисел x + y + z должна быть минимальной.
Соблазнительно решить задачу методом грубой силы, просто перебирая
числа в трёх вложенных циклах for. Имея много времени, можно дождаться
решения задачи, но через пару минут становится очевидно, что на сайте
Проект Эйлера не предложили бы задачу на банальный перебор в циклах.
Значит, проблему нужно решать иначе.
Поскольку все выражения – это квадраты натуральных чисел, то мы можем
обозначить их так:
x
x
x
x
y
y

–
+
–
+
–
+

y
y
z
z
z
z

=
=
=
=
=
=

a2
b2
c2
d2
e2
f2

(1)
(2)
(3)
(4)
(5)
(6)

Складываем два первых равенства:
x – y + x + y = a2 + b2
247

Откуда:
x = (a2 + b2)/2

(7)

Вычитая из второго равенства первое, получаем:
y = (b2 - a2)/2

(8)

Из равенств (7) и (8) вытекает, что числа a и b либо оба чётные, либо оба
нечётные, иначе числа x и y будут дробными.
Так как y > 1, то
(b2 - a2)/2 > 1
и
b > a
Вычитая из выражения (4) выражение (3), получаем:
x + z – (x - z) = d2 + c2
Или:
z = (d2 - c2)/2

(9)

Складывая выражения (3) и (4), находим:
x + z + (x - z) = d2 + c2
x = (d2 + c2)/2
Из выражения (7) следует, что:
x = (d2 + c2)/2

= (a2 + b2)/2

То есть:
d2 = a2 + b2 - c2
Подставляя в выражение (9), получаем формулу для вычисления z:
248

z = (a2 + b2 - c2 - c2)/2
z = (a2 + b2)/2 - c2
z = x - c2
Нам опять потребуются 3 вложенных цикла для чисел a, b и c, но теперь
диапазон их изменения гораздо меньше!
Поскольку b > a > 1, то b не может равняться 1 и 2, в противном случае а
будет равно 0. Итак, переменная цикла b изменяется от 3 до – пока мы не
найдём решения задачи. Переменная цикла а изменяется от 1 или от 2 – в
зависимости от того, нечётное или чётное число b. Причём а изменяется с
приращением 2, иначе его чётность будет отличаться от чётности числа b.
Для числа с имеем:
z < y → x - c2 < y → x - y < c2 → (a2 + b2)/2 - (b2 - a2)/2 < c2 →
a2 < c2 → a < c
С другой стороны,
z = x – c2 > 0 → x > c2 → c < √𝑥
Так как
x = (a2 + b2)/2
и a < b, то с < b.
Таким образом, переменная цикла c изменяется от a + 1 до b - 1.
После теоретических изысканий мы без труда напишем процедуру для решения задачи:
uses MathExtensions;

// РЕШАЕМ ЗАДАЧУ
procedure Solve();

249

begin
var b := 3;
while True do begin
var b2 := b * b;
for var a := 1 + (0 and b) to b - 1 step 2 do begin
var a2 := a * a;
var x := (a2 + b2) shr 1;// 2;
for var c := a + 1 to b - 1 do begin
var y := (b2 - a2) shr 1;// 2;
var z := x - c * c;
if IsQuadrat(y IsQuadrat(y +
IsQuadrat(x IsQuadrat(x +
begin
| a, b, c,
WriteLn($'
Writeln;
WriteLn($'
WriteLn($'
WriteLn($'
WriteLn($'
WriteLn($'
WriteLn($'
Writeln;
exit;
end;
end;
end;
b += 1;
end;
Writeln(' РЕШЕНИЙ НЕТ');
Writeln;
end;

z)
z)
z)
z)

and
and
and
then

x, y, z |.Println;
Наименьшая сумма x+y+z равна {x+y+z}');
x-y
x+y
x-z
x+z
y-z
y+z

=
=
=
=
=
=

{x-y}
{x+y}
{x-z}
{x+z}
{y-z}
{y+z}

-> {Sqrt(x-y)} * {Sqrt(x-y)}');
-> {Sqrt(x+y)} * {Sqrt(x+y)}');
-> {Sqrt(x-z)} * {Sqrt(x-z)}');
-> {Sqrt(x+z)} * {Sqrt(x+z)}');
-> {Sqrt(y-z)} * {Sqrt(y-z)}');
-> {Sqrt(y+z)} * {Sqrt(y+z)}');

begin
Writeln(' Project Euler. Problem 142');
Writeln;
Solve();
end.

Здесь мы применили некоторую оптимизацию кода, чтобы ускорить процесс.
250

Условный оператор:
if (b mod 2 = 1) then a := 1
else a := 2;

заменили побитовым:
a := 1 + (0 and b)

Деление на двойку – оператором сдвига вправо.
Задача оказалась непростой!
Project Euler. Problem 142
117 925 533 434657 420968 150568
Наименьшая сумма x+y+z равна 1006193
x-y
x+y
x-z
x+z
y-z
y+z

=
=
=
=
=
=

13689
855625
284089
585225
270400
571536

->
->
->
->
->
->

117
925
533
765
520
756

*
*
*
*
*
*

117
925
533
765
520
756

Проект Пандигитальные квадраты
Исходный код программы находится в файле Пандигитальные квадраты.pas.
Мы ощутимо пощупали с разных сторон и боков пандигитальные числа в
эйлеровских проектах, но вдобавок и вдогонку к ним у нас созрели пандигитальные квадраты.
251

Эта задача не новая. Она имеет давнюю историю. Например, в журнале
Наука и жизнь, №11 за 1970 год я отыскал сообщение, что найдены 85 10значных пандигитальных квадратов.

А ещё раньше, в номере 7 нашлось и начало этой задачи. Там были показаны
лицом народу два 10-значных пандигитальных квадрата. Итого в 1970 году
читатели журнала Наука и жизнь нашли все 87 10-значных пандигитальных квадратов.

Как они это сделали мы не знаем, но персональных компьютеров и программируемых калькуляторов в 1970 году ещё не было. А у нас компьютеры есть
252

и в наличии, так что мы не сломя голову должны повергнуть и подмять под
себя эту задачу из прошлого века.
Но, чтобы не просто повторить этот героический подвиг, мы найдём ещё и
9-значные пандигитальные квадраты. Тут мы можем действовать по аналогии с 10-значными пандигитальными квадратами, так что в общем и целом работы нам предстоит немного, можно даже не засучать спустя рукава.

253

Для легкоты́ и легкови́ зны восприятия решения задачи мы сначала отыщем
девятизначные пандигитальные квадраты, а вслед за ними и вдогонку – десятизначные.
Подробно рассмотрим отыск девятизначных пандигитальных квадратов,
а с десятизначными поступайте так же, но строже.
Вычисляем пределы изменения чисел, которые порождают девятизначные
квадраты. Это сугубая математика.
uses MathExtensions;

// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
Println($' Квадратные пандигитальные числа (цифры 1..9, без нуля):');
var minN := ISqrt(123456789); // ~11112
var maxN := ISqrt(987654321); // ~31426

Для всезнающей статистики считаем пандигитальные квадраты, которые
мы ищем в цикле for - от и до - как мы это порешили только что раньше.
var count19 := 0;
// решаем задачу:
for var n := minN to maxN do begin

Вычисляем квадрат текущего значения переменной цикла.
var square: int64 := n * n;

Крайне желательно, чтобы квадрат оказался пандигитальным. Но это уже
решаем не мы, а судьба в образе функции IsPandigital из модуля
MathExtensions.
254

// ПРОВЕРЯЕМ ЧИСЛО С ЦИФРАМИ 1.. 9 НА ПАНДИГИТАЛЬНОСТЬ
function IsPandigital(n: int64): bool;
begin
var s := n.ToString();
Result := s.OrderBy(c -> c)
.SequenceEqual('123456789');
end;

Печатаем очередной отысканный девятизначный пандигитальный квадрат, не забывая преувеличивать и преумножать счётчик квадратных найдёнышей:
if IsPandigital(square) then begin
count19 += 1;
// печатаем число::
Println($' {n}^2 = {square}');
end;
end;

Окончательно отчитываемся перед собой числом найденных девятизначных пандигитальных квадратов.
Println($' Найдено {count19} квадратных пандигитальных чисел (цифры
0..9, без нуля)');
WriteLn;

С десятизначными пандигитальными квадратами действуйте совершенно
аналогично, только длиннее, чем короче:
// ПРОВЕРЯЕМ ЧИСЛО С ЦИФРАМИ 0.. 9 НА ПАНДИГИТАЛЬНОСТЬ
function IsPandigital0To9(n: int64): bool;
begin
// в числе должно быть 10 цифр 0..9:
var s := n.ToString();
Result := s.OrderBy(c -> c)
.SequenceEqual('0123456789');
255

end;

Println($' Квадратные пандигитальные числа (цифры 0..9, с нулём):');
// диапазон n, при котором n^2 — 10-значное число:
minN := ISqrt(1023456789); // ~31992
maxN := ISqrt(9876543210); // ~99380
var count09 := 0;
// решаем задачу:
for var n := minN to maxN do begin
var square: int64 := n * n;
if IsPandigital0To9(square) then begin
count09 += 1;
// печатаем число::
Println($' {n}^2 = {square}');
end;
end;
Println($' Найдено {count09} квадратных пандигитальных чисел (цифры
0..9, с нулём)');
WriteLn;
end;

begin
Writeln(' Пандигитальные квадраты');
WriteLn;
Solve();
end.

Запускаем программу вза́ пуски. И тут же наблюдаем весьма приятную для
пущих глаз картину с исчерпывающем списком всех полноценных пандигитальных квадратов, коих оказалось: сначала 30, а затем - 87. Всё строго по
науке:
Пандигитальные квадраты
Квадратные пандигитальные числа (цифры 1..9, без нуля):
11826^2 = 139854276
12363^2 = 152843769

19629^2 = 385297641
20316^2 = 412739856

25059^2 = 627953481
25572^2 = 653927184
256

12543^2
14676^2
15681^2
15963^2
18072^2
19023^2
19377^2
19569^2

=
=
=
=
=
=
=
=

157326849
215384976
245893761
254817369
326597184
361874529
375468129
382945761

22887^2
23019^2
23178^2
23439^2
24237^2
24276^2
24441^2
24807^2

=
=
=
=
=
=
=
=

523814769
529874361
537219684
549386721
587432169
589324176
597362481
615387249

25941^2
26409^2
26733^2
27129^2
27273^2
29034^2
29106^2
30384^2

=
=
=
=
=
=
=
=

672935481
697435281
714653289
735982641
743816529
842973156
847159236
923187456

Найдено 30 квадратных пандигитальных чисел (цифры 0..9, без нуля)

Квадратные пандигитальные числа (цифры 0..9, с нулём):
32043^2
32286^2
33144^2
35172^2
35337^2
35757^2
35853^2
37176^2
37905^2
38772^2
39147^2
39336^2
40545^2
42744^2
43902^2
44016^2
45567^2
45624^2
46587^2
48852^2
49314^2
49353^2
50706^2
53976^2
54918^2
55446^2
55524^2
55581^2

=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=

1026753849
1042385796
1098524736
1237069584
1248703569
1278563049
1285437609
1382054976
1436789025
1503267984
1532487609
1547320896
1643897025
1827049536
1927385604
1937408256
2076351489
2081549376
2170348569
2386517904
2431870596
2435718609
2571098436
2913408576
3015986724
3074258916
3082914576
3089247561

56532^2
57321^2
58413^2
58455^2
58554^2
59403^2
60984^2
61575^2
61866^2
62679^2
62961^2
63051^2
63129^2
65634^2
65637^2
66105^2
66276^2
67677^2
68763^2
68781^2
69513^2
71433^2
72621^2
75759^2
76047^2
76182^2
77346^2
78072^2

=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=

3195867024
3285697041
3412078569
3416987025
3428570916
3528716409
3719048256
3791480625
3827401956
3928657041
3964087521
3975428601
3985270641
4307821956
4308215769
4369871025
4392508176
4580176329
4728350169
4730825961
4832057169
5102673489
5273809641
5739426081
5783146209
5803697124
5982403716
6095237184

80361^2
80445^2
81222^2
81945^2
83919^2
84648^2
85353^2
85743^2
85803^2
86073^2
87639^2
88623^2
89079^2
89145^2
89355^2
89523^2
90144^2
90153^2
90198^2
91248^2
91605^2
92214^2
94695^2
95154^2
96702^2
97779^2
98055^2
98802^2

=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=

6457890321
6471398025
6597013284
6714983025
7042398561
7165283904
7285134609
7351862049
7362154809
7408561329
7680594321
7854036129
7935068241
7946831025
7984316025
8014367529
8125940736
8127563409
8135679204
8326197504
8391476025
8503421796
8967143025
9054283716
9351276804
9560732841
9614783025
9761835204
257

55626^2 = 3094251876

78453^2 = 6154873209

99066^2 = 9814072356

Найдено 87 квадратных пандигитальных чисел (цифры 0..9, с нулём)

Программисты люди серьёзные, поэтому любят шутить, играючи шаля словами и коверкая их вкось. Всем известен машинный перевод с одного
языка на другой. И обратно, и опять.
Слегка каламбурим, чтобы получить мышиный перевод, то есть перевод
старых мышек через дорогу молодыми мышками.

Проект Кратные пандигитальные числа
Исходный код программы находится в файле Кратные пандигитальные числа.pas.

258

Кратные пандигитальные числа
Если мы умножим какое-либо пандигитальное число на однозначное число k,
то произведение может оказаться другим пандигитальным числом.
Найдите все пары таких чисел.
Эта задача сродни задаче 032 из Проекта Эйлера.
Пределы изменения числа k легко установить:
• Если k = 0, то произведение всегда равно нулю.
• Если k = 1, то произведение равно исходному числу.
• Если k > 9, то произведение будет 11-значным числом, то есть хотя бы две
цифры обязательно повторятся.
Правильно переставлять цифры мы научились:
// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
// цифры:
var digits := (0..9);
// множитель:
var k := 9;
// считаем пандигитальные числа:
var np := 0;
// перебираем все перестановки
foreach var perm in digits.Permutations do begin

В этом проекте нам нужна не строка, а число, поэтому пишем новый метод
расширения для последовательностей ToNumber, который возвращает
число типа int64, собранное из заданной последовательности цифр:
function ToNumber(self: sequence of int): int64;
begin
var num: int64 := 0;
foreach var d in self do begin

extensionmethod;

259

if (d < 0) or (d > 9) then
raise new System.ArgumentException('Цифры должны быть в диапазоне 0–9!');
num := num * 10 + d;
end;
Result := num;
end;

Итак, метод Permutations последовательно выдаёт массивы перестановок
десяти цифр, а мы превращаем их в число:
var num := perm.ToNumber;

Умножаем на заданное однозначное число k:
var numk := num * k;

Если произведение не пандигитальное, переставляем цифры дальше:
if not IsPandigital0To9(numk) then continue;

В противном, но благоприятном для нас случае мы увеличиваем счётчик
найденных пандигитальных чисел и печатаем очередную пару на экране:
// увеличиваем счётчик пандигитальных чисел:
np += 1;
Writeln($' {num} * {k} = {num * k}');
end;

Заканчиваем перебор публикованием числа найденных пандигитальных
произведений:
Writeln($' Всего: {np}');
WriteLn;
260

end;

begin
Writeln(' Кратные пандигитальные числа');
WriteLn;
Solve();
end.

261

Пандигитальных произведений оказалось очень много!
519327486 * 2
519328647 * 2
519328746 * 2
519346287 * 2
Всего: 211968

=
=
=
=

1038654972
1038657294
1038657492
1038692574

1643928507 *
1643928570 *
1645270839 *
1645839027 *
Всего: 2316

6
6
6
6

=
=
=
=

9863571042
9863571420
9871625034
9875034162

695847321 *
712348965 *
712349856 *
712354986 *
Всего: 7584

3
3
3
3

=
=
=
=

2087541963
2137046895
2137049568
2137064958

1408753629 *
1408957362 *
1409352876 *
1409632875 *
Всего: 1497

7
7
7
7

=
=
=
=

9861275403
9862701534
9865470132
9867430125

458137269 * 4
458173926 * 4
458176239 * 4
458192376 * 4
Всего: 10432

=
=
=
=

1832549076
1832695704
1832704956
1832769504

1230879564 *
1234067895 *
1234506789 *
1234567890 *
Всего: 1534

8
8
8
8

=
=
=
=

9847036512
9872543160
9876054312
9876543120

248761953 * 5
248791356 * 5
248791536 * 5
248793156 * 5
Всего: 87552

=
=
=
=

1243809765
1243956780
1243957680
1243965780

1095672483
1096347825
1096734825
1097368245
Всего: 870

9
9
9
9

=
=
=
=

9861052347
9867130425
9870613425
9876314205

*
*
*
*

Проект Enigma 1436: One more step
Исходный код программы находится в файле Enigma1436.pas.

В журнале New Scientist #2597 от 31-го марта 2007 года была напечатана задача Enigma 1436:
Задача номер 1436 называется One more step.
262

I invite you to consider the following series of numbers: 1, 3, 7, 13, 21 …
Then find the following:
(a) The six-hundredth member of the series.
(b) A member of the series above the first with less than five digits which is a perfect
cube.
(c) A member which is a five-digit palindrome which can also be read as a binary
number.
(d) The smaller of the two consecutive members which are 1000 apart.
Рассмотрим следующий ряд чисел: 1, 3, 7, 13, 21 …
Найдите:
(a) Шестисотый член ряда.
(b) Член ряда, который:
больше первого,
состоит менее чем из пяти цифр и
является кубом целого числа.
(c) Член ряда, который:
является палиндромом с пятью цифрами,
может быть прочитан как двоичное число.
(d) Два наименьших последовательных члена ряда, разность между которыми равняется 1000.
Прежде чем решать задачу, мы должны научиться вычислять члены ряда.
Обозначим ряд буквой a, тогда первый член равняется:
а1 = 1
Обозначим разность между членами ряда буквой d, тогда:
263

d1 = 3-1 = 2
d2 = 7-3 = 4
d3 = 13-7 = 6
d4 = 21-13 = 8
. . .
dn = 2 * n,
где n – номер члена ряда.
Теперь мы легко найдём любой член ряда:
an = an-1 + dn
Для вывода нерекуррентной формулы воспользуемся методом исчисления конечных разностей, который описан в книге Мартина Гарднера [ГМ72],
на страницах 81-95:
1 3 7 13 21
2 4 6 8
2 2 2
Откуда:
an = n2 – n + 1

(1)

Переходим к решению задачи и вызываем процедуру Solve, которая и даст
нам ответы на все вопросы:
begin
Writeln(' Enigma1436');
Writeln;
Solve();
end.

264

Подзадачу (а) мы решаем, просто подставив номер члена 600 в формулу (1):
uses MathExtensions;

// ВЫЧИСЛЯЕМ n-ный ЧЛЕН РЯДА
function GetAn(n: int) := n * n - n + 1;

// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
//(a)
WriteLn($' n = {600,3}

a = {GetAn(600),3}');

Writeln;
end;

Enigma1436
n = 600

a = 359401

Для решения подзадачи (b) у нас есть простой метод расширения, который
умеет определять, является ли заданное целое число точным кубом:
function IsCube(Self: int64): boolean; extensionmethod;
begin
var r := Trunc(Round(Power(self, 1.0 / 3.0)));
Result := r * r * r = self;
end;

Все условия этой подзадачи легко записать внутри бесконечного цикла
while:
//(b)
var n := 1;
while True do begin
265

var a := GetAn(n);
if (n > 1) and (a <= 9999) and a.IsCube then begin
WriteLn($' n = {n,3} a = {a,3} cube = {Power(a, 1.0 / 3)}');
break;
end;
n += 1;
end;

Здесь:
- Номер n искомого члена ряда больше единицы:
n > 1

- Искомый член a ряда состоит менее чем из пяти цифр:
a <= 9999

- Искомый член ряда a – точный куб:
a .IsCube()

Поскольку мы заранее не знаем, какой член ряда удовлетворит этим условиям, то запускаем бесконечный цикл, который прерываем сразу, как
только найдём заданный член ряда:
Enigma1436
n = 600
n = 19

a = 359401
a = 343 cube = 7

Подзадачу (с) мы решаем аналогично, но условие прекращения цикла
должно включать проверки, что очередной член ряда:
•
•
•

пятизначное число
палиндром
состоит только из цифр 0 и 1
266

//(c)
n := 0;
while True do begin
n += 1;
var a := GetAn(n);
if (a > 99999) then break;
if (a < 10000) then continue;
var s := a.ToString();
var r := s.Reverse;
if (s.Contains('0')) or (s.Contains('1')) and (s = r) then
begin
WriteLn($' n = {n,4} a = {s,4}');
break;
end;
end;

Здесь:
- Искомый член a ряда состоит из пяти цифр:
if (a > 99999) then break;
if (a < 10000) then continue;

- Искомый член ряда a – палиндром:
var s := a.ToString;
var r := s.Reverse;
(s = r)

- Искомый член ряда состоит из цифр 0 и 1:
(s.Contains('0')) or (s.Contains('1'))

Все условия соблюдены, запускаем программу – и находим решение подзадачи (с):
Enigma1436
267

n = 600 a = 359401
n = 19 a = 343 cube = 7
n = 101 a = 10101

И последнюю подзадачу мы решаем без труда:
//(d)
n := 1;
while True do begin
var a0 := GetAn(n);
var a1 := GetAn(n+1);
if a1 - a0 = 1000 then begin
WriteLn($' n0 = {n,3} n1 = {n + 1,3}
break;
end;
n += 1;
end;

a0 = {a0,6}

a1 = {a1,6}');

Если мы начнём с первого члена ряда (n=1), то нам нужно найти разность
между ним и следующим членом ряда, номер которого на единицу больше.
Если эта разность не равняется 1000, то переходим ко второму члену ряда
и находим разность между ним и третьим членом ряда. Продолжаем так до
тех пор, пока не получим заданную разность:
Enigma1436
n = 600 a = 359401
n = 19 a = 343 cube = 7
n = 101 a = 10101
n0 = 500 n1 = 501 a0 = 249501

a1 = 250501

Проект Enigma 1496: Eighteen
Исходный код программы находится в файле Enigma1496.pas.

268

В журнале New Scientist #2658 от 31-го марта 2008 года была напечатана задача Enigma 1496:
Задача номер 1496 называется Eighteen.
An eight-digit “multiplicand” comprising dots and letters is multiplied by 2 resulting
in the product EIGHTEEN, as shown in the multiplication below, where different letters stand for different digits, the same letter stands for the same digit, and a dot can
be any digit.
• • N I N E • •
× 2
--------------E I G H T E E N
What is the eight-letter product EIGHTEEN?
При умножении восьмизначного числа на 2 получается произведение
EIGHTEEN:
• • N I N E • •
× 2
--------------E I G H T E E N
Разным буквам соответствуют разные цифры, и наоборот. Точки заменяют любые цифры.
Найдите восьмибуквенное произведение EIGHTEEN.
Легко подсчитать, что в задаче используются всего 6 разных букв: E, I, G, H,
T и N, которые могут принимать значения от 0 до 9.
• Для решения задачи мы составим все размещения 6 чисел из 10.
• После каждого размещения присвоим значения переменным
e,i,g,h,t,n.
• Вычислим значение произведения eighteen.
269

• Разделим eighteen на 2.
• Вычислим значение переменной nine.
• Выделим из числа eighteen 4 средние цифры и сравним с nine. Если
они совпали, то решение найдено.
Для генерирования всех размещений воспользуемся библиотекой Generics
Combinatorics:
{$reference GenericsCombinatorics.dll}
uses Facet.Combinatorics;
// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
var arr := Range(0, 9).ToArray();
var vars := new Variations<integer>(arr, 6, GenerateOption.WithoutRepetition);

В цикле foreach просматриваем все размещения и присваиваем значения
переменным:
var num := 0;
foreach var v in vars do begin

При этом мы учитываем, что Е не может быть нулём, а N – чётная цифра:
var e
if (e
var n
if (n
var i
var g
var h
var t

:= v[0];
= 0) then continue;
:= v[1];
mod 2 <> 0) then continue;
:= v[2];
:= v[3];
:= v[4];
:= v[5];

Зная значения всех переменных, вычисляем eighteen и nine:
270

var eighteen := ((((((e*10 + i)*10 + g)*10 + h)*10 + t)*10 + e)*10
+ e)*10 + n;

Находим половину числа eighteen, выделяем их него 4 средние цифры и
сравниваем их с числом nine:
var eighteen2 := eighteen div 2;
var nine := ((n * 10 + i) * 10 + n) * 10 + e;
if (eighteen2 div 100) mod 10000 <> nine then continue;
// нашли решение:
Writeln($' NINE = {n}{i}{n}{e}');
Writeln($' EIGHTEEN = {e}{i}{g}{h}{t}{e}{e}{n}');
num += 1;
end;
Writeln($' Всего решений: {num}');
Writeln;
end;

begin
Writeln(' Enigma1496');
Writeln;
Solve();
end.

Запускаем программу и находим единственное решение задачи:
Enigma 1496: Eighteen
NINE = 8189
EIGHTEEN = 91637998
Всего решений: 1

271

Проект Enigma 1504: All ten digits
Исходный код программы находится в файле Enigma1504.pas.

В журнале New Scientist #2666 от 26-го июля 2008 года была напечатана задача Enigma 1504:
Задача номер 1504 называется All ten digits.
Harry has chosen some 5-digit perfect squares (all different) which use only the digits 0 to 4, none of them starting or finishing with the digit 0. Each of the digits 0 to
4 is used a different number of times in his squares, those numbers of times being 5
to 9.
(1) Which eligible square or squares has Harry NOT chosen?
Tom has chosen some 5-digit perfect squares which only use the digits 5 to 9. Each
of the digits 5 to 9 is used a different number of times in his squares, those numbers
of times being 0 to 4.
(2) Which squares has Tom chosen?
По-русски её смысл можно передать такими словами.
Гарри выбрал несколько разных пятизначных квадратов натуральных чисел, которые состоят только из цифр 0..4, но ни одно из них не начинается и
не заканчивается на 0. Каждая из этих цифр в выбранных числах встречается от 5 до 9 раз – для всех цифр суммы различны.
Вопрос 1: Какое число или числа не выбрал Гарри?
Том также выбрал несколько разных пятизначных квадратов натуральных
чисел, которые состоят только из цифр 5..9. Каждая из этих цифр в выбранных числах встречается от 0 до 4 раз – для всех цифр суммы различны.
272

Вопрос 2: Какие числа выбрал Том?
Для ответа на каждый из этих вопросов, прежде всего, нужно найти все пятизначные числа, которые удовлетворяют условиям задачи, а затем выбрать из них нужные.
Наименьшее пятизначное число Гарри – 10000, а наибольшее – 44444, так
что мы легко переберём его числа в цикле:
uses MathExtensions;
var dig1 := | '0', '1', '2', '3', '4' |;
var digits1 := new HashSet<char>(dig1);
var dig2 := | '5', '6', '7', '8', '9' |;
var digits2 := new HashSet<char>(dig2);
// РЕШАЕМ ЗАДАЧУ
procedure Problem1();
begin
var lst := new List<array of char>();
for var i := ISqrt(10000) to ISqrt(44444) do begin

При этом ни одно число не начинается с нуля, а вот последнюю цифру
нужно проверить!
Числа Тома можно найти аналогично:
procedure Problem2();
begin
var lst := new List<array of char>();
for var i := ISqrt(50000) to ISqrt(99999) do begin

И числа Гарри, и числа Тома нужно проверить на наличие в них посторонних «примесей» в виде цифр 5..9 и 0..4, соответственно.

273

Чтобы определить, сколько чисел выбрали Гарри и Том из полученного
списка, найдём суммы вхождений их цифр:
5 + 6 + 7 + 8 + 9 = 35
0 + 1 + 2 + 3 + 4 = 10
Значит, Гарри выбрал 35 : 5 = 7 чисел, а Том выбрал 10:5 = 2 числа.
Таким образом, нужно выбирать из списка такие наборы, чтобы они удовлетворяли условиям задачи.
Поскольку выделять цифры из числа – задача непростая, то лучше перевести их в строку:
var sq := (i * i).ToString();

А затем – в массив цифр:
var csq := sq.ToCharArray();

Создаём из цифр чисел Гарри и Тома множества, а затем с помощью метода
IsSupersetOf класса HashSet легко определяем, содержатся ли все нужные
цифры в массиве цифр csq.
Тогда в списке Гарри окажется 8 чисел, а в списке Тома – 5:
10201
10404
12321
22201
23104
32041
33124
40401
55696
69696
274

97969
98596
99856

Всего подходящих чисел для Гарри – 8. Из них нужно оставить 7, а выбросить одно – оно и является ответом на первую часть задачи.
В двух циклах for мы можем последовательно отобрать возможное лишнее
число и все наборы из 7 чисел:
for var i := 0 to lst.Count-1 do begin
var sum := new int[5];
for var j := 0 to lst.Count-1 do begin

Аналогично мы можем отобрать и 2 числа для Тома:
for var i := 0 to lst.Count-2 do begin
for var j := i + 1 to lst.Count-1 do begin
var sum := new int[10];

Проблема с проверкой сумм может быть решена с помощью логического
массива:
var b := new bool[10];

Начнём с решения первой части задачи.
Отберём в список lst все пятизначные числа, которые не заканчиваются нулём и состоят только из цифр в множестве digits1, то есть 0..4:
// РЕШАЕМ ЗАДАЧУ
procedure Problem1();
begin
var lst := new List<array of char>();
for var i := ISqrt(10000) to ISqrt(44444) do begin
275

var sq := (i * i).ToString();
var csq := sq.ToCharArray();
if (csq[csq.Length-1] = '0') then
continue;
if not digits1.IsSupersetOf(csq) then
continue;
lst.Add(csq);
Writeln(sq);
end;

Если число заканчивается на нуль, то последний символ в массиве csq равняется '0'. Такие числа мы пропускаем.
Если все символы массива csq содержатся в множестве digits1, то оно является надмножеством для множества csq. Если это не так, то метод IsSupersetOf вернёт false (в массиве csq есть хотя бы одна цифра, отсутствующая в
digits1), и мы переходим к следующей итерации.
Если же число выдержало обе проверки, то мы добавляем его в список lst.
Результат отбора чисел вы уже видели выше.
Мы знаем, что одно из восьми чисел – лишнее. В цикле for последовательно
назначаем одно из чисел «лишним». Остальные 7 чисел должны быть такими, чтобы каждая цифра в них присутствовала в разных количествах. Для
этого мы сначала подсчитываем число вхождений каждой цифры в каждое
число и в массиве sum получаем нужные данные:
Writeln;
// проверяем все числа в списке:
for var i := 0 to lst.Count-1 do begin
//WriteLn($' Первое число = {new String(lst[i])}');
// остальные 7 чисел:
var sum := new int[5];
for var j := 0 to lst.Count-1 do begin
if (j = i) then continue;
for var k := 0 to 5-1 do
sum[ord(lst[j][k])-ord('0')] += 1;
276

WriteLn($' Число = {new String(lst[j])}' );
end;
foreach var n in sum do
Write($' {n,1}');
WriteLn();
WriteLn();

Проверяем, что все суммы в массиве sum различны:
// все суммы цифр должны быть различны:
var b := new bool[10];
var flg := true;
foreach var n in sum do
if (b[n]) then begin
flg := false;
break;
end
else b[n] := true;

Если это так, то флаг flg равен true – семёрка чисел выполняет условия задачи, а первое число нужно исключить:
if (flg) then begin
WriteLn($' Исключаем число: {new String(lst[i])}');
exit;
end;
end;
end;

Запускаем программу и получаем ответ на первый вопрос: исключить
нужно число 22201:
Первое
Число
Число
Число
Число
Число

число = 10201
= 10404
= 12321
= 22201
= 23104
= 32041

Первое
Число
Число
Число
Число
Число

число = 12321
= 10201
= 10404
= 22201
= 23104
= 32041
277

Число = 33124
Число = 40401
7 8 8 5 7

Число = 33124
Число = 40401
9 8 7 4 7

Первое число = 10404
Число = 10201
Число = 12321
Число = 22201
Число = 23104
Число = 32041
Число = 33124
Число = 40401
7 9 9 5 5

Первое число = 22201
Число = 10201
Число = 10404
Число = 12321
Число = 23104
Число = 32041
Число = 33124
Число = 40401
8 9 6 5 7
Исключаем число: 22201

Переходим ко второму вопросу задачи.
Начало процедуры Problem2 почти в точности повторяет предыдущую:
procedure Problem2();
begin
var lst := new List<array of char>();
for var i := ISqrt(50000) to ISqrt(99999) do begin
var sq := (i * i).ToString();
var csq := sq.ToCharArray();
if not digits2.IsSupersetOf(csq) then
continue;
lst.Add(csq);
Writeln(sq);
end;

Теперь мы последовательно выбираем по 2 числа и проверяем сумму цифр
для каждой пары чисел. Как только мы найдём такую пару, что все числа в
массиве sum окажутся различными, напечатаем решение на экране и прекратим дальнейшие розыскные работы:
for var i := 0 to lst.Count-2 do begin
for var j := i + 1 to lst.Count-1 do begin
278

var sum := new int[10];
for var k := 0 to 5-1 do
sum[ord(lst[i][k])-ord('0')] += 1;
for var k := 0 to 5-1 do
sum[ord(lst[j][k])-ord('0')] += 1;
// все суммы цифр должны быть различны:
var b := new bool[10];
var flg := true;
for var n := 5 to 9 do
if (b[sum[n]]) then begin
flg := false;
break;
end
else b[sum[n]] := true;
if (flg) then begin
Write(' Искомые числа: ');
Write(new String(lst[i]));
Write(' и: ');
Write(new String(lst[j]));
WriteLn(); WriteLn();
exit;
end;
WriteLn();
end;
WriteLn();
end;
WriteLn();
end;

begin
Writeln(' Enigma 1504: All ten digits');
Writeln;
Problem1();
Problem2();
end.

Искомая пара чисел Тома – 55696 и 97969:
Искомые числа: 55696 и: 97969
279

Для любителей поломать себе голову о функциональное программирование есть другое решение.
Здесь нам сразу понадобится генератор комбинаций:
uses MathExtensions;
// ГЕНЕРИРУЕТ ВСЕ КОМБИНАЦИИ ИЗ k ЭЛЕМЕНТОВ ЗАДАННОЙ КОЛЛЕКЦИИ
function GetCombinations<T>(elements: array of T; k: int): sequence of
array of T;
begin
var n := elements.Length;
if k > n then exit;
// инициализируем индексы:
var indices := ArrGen(k, i -> i);
while true do begin
// создаём комбинацию по текущим индексам:
var combination := new T[k];
for var i := 0 to k - 1 do
combination[i] := elements[indices[i]];
yield combination;
// следующий набор индексов:
var i := k - 1;
while (i >= 0) and (indices[i] = n - k + i) do
i := i - 1;
// комбинации закончились:
if i < 0 then break;
indices[i] := indices[i] + 1;
for var j := i + 1 to k - 1 do
indices[j] := indices[j - 1] + 1;
end;
end;

Мы опять разбиваем задачу на две части, чтобы легче ориентироваться в
коде и спонтанно передрать код из одной части решения в другую – отдельно для Гарри и Тома, что разумно и вытекает струёй из условия задачи.
280

Для надёжного хранения цифр и квадратов чисел определяем множества:
// Гарри
procedure Harry();
begin
// множество допустимых цифр для Гарри:
var digits := new HashSet<char>('01234');
// множество подходящих квадратов:
var squares := new HashSet<string>();

Более подробно и сначала мы круто разберёмся с Гарри, у которого цифры
меньше, значит, он не столь опасен, как Том – даже без Джерри.
Легко установить, что наименьшее пятизначное число Гарри – 10000, а
наибольшее – 44444. Переменная цикла должна принять на себя лимиты от
и до квадратных корней этих чисел, чтобы квадраты пришлись тютелька в
тютельку.
// ищем среди чисел, которые дают пятизначные квадраты:
var minNum := ISqrt(10000); // 100
var maxNum := ISqrt(44444); // 210

Понятно, что ни одно число не начнётся с нуля, а вот последнюю цифру придётся строго проверить!
В цикле for мы находим квадраты чисел в строковом исполнении, чтобы не
утруждать себя излишними манипуляциями с цифрами чисел.
Убеждаемся, что последняя цифра не нуль:
for var i := minNum to maxNum do begin
// пятизначные квадраты:
var sn := (i * i).ToString();
// последняя цифра не 0:
if (sn[^1] = '0') then continue;

281

Убедиться в этом можно и с числом, но нужно ещё тщательней проверить,
что все цифры на месте. Со строкой это легче, чем проще.
Мы нашли квадрат числа, который годится и годен для условия задачи. Отправляем его в множество скверов. Там ему будет совсем не скверно.
// не все цифры:
if not sn.All(digits.Contains) then continue;
// добавляем квадрат в множество:
squares.Add(sn);
// печатаем квадрат на экране:
Writeln($' Гарри: {i}^2 = {sn}')
end;

Каждая цифра должна встречаться уникальное число раз – от пяти до девяти. Сумма этих чисел равна тридцати пяти, а чисел пять, то есть мы
должны выбрать 7 чисел.
// каждая цифра должна встречаться 5, 6, 7, 8 или 9 раз:
var r: HashSet<int> := [ 5, 6, 7, 8, 9 ];
// нужно выбрать 7 чисел
// каждое число из 5 цифр → 35 / 5 = 7
var n := r.Sum div 5;

И вот пошла сугубая комбинаторика! Из множества квадратов мы выбираем все семёрки чисел с помощью новой функции GetCombinations. Она
получает массив строковых представлений чисел и количество элементов
в комбинации.
// перебираем все комбинации из 7 чисел:
foreach var combo in GetCombinations(squares.ToArray, n) do begin

Создаём словарь: цифра, частота в комбинации чисел.
Теперь мы проверяем, что частота цифр полностью совпадает с указанной
в условии, то есть по одному разу от пяти до девяти.
282

// собираем числа в строку:
var combined := string.Join('', combo);
// считаем, сколько раз встречается каждая цифра
// в словаре получаем пары: цифра, частота:
var counter := combined.GroupBy(c -> c)
.ToDictionary(g -> g.Key, g -> g.Count());

Для порядка инвентаризации сортируем все проходные комбинации из
семи чисел. Невыбранные числа – это разность множеств квадратов и комбинации:
// проверяем: множество частот должно совпадать с {5,6,7,8,9}
if (counter.Values
.ToHashSet()
.SetEquals(r)) then
begin
// сортируем числа:
var sortedChosen := combo.OrderBy(x -> x);
// находим невыбранные числа как разность множеств:
var notChosen := squares.Except(combo)
.OrderBy(x -> x);

Эх, ухнули! А дальше сама пойдёт. Припечатываем Гаррика к экрану.
// печатаем ответ для Гарри:
var str := string.Join(', ', sortedChosen);
Writeln($' Гарри выбрал: {str}');
Writeln($' Гарри не выбрал: {notChosen.First}');
Writeln;
end;
end;
end;

Задача для Тома решается аналогично:
// Том
283

procedure Tom();
begin
// множество допустимых цифр для Тома:
var digits := new HashSet<char>('56789');
// множество подходящих квадратов:
var squares := new HashSet<string>();
// перебираем числа, которые дают пятизначные квадраты:
var minNum := ISqrt(50000); // 236
var maxNum := ISqrt(99999); // 316
for var i := minNum to maxNum do begin
var sn := (i * i).ToString();
if not sn.All(digits.Contains) then continue;
squares.Add(sn);
// печатаем квадрат на экране:
Writeln($' Том: {i}^2 = {sn}')
end;
// каждая цифра должна встречаться 1, 2, 3 или 4 раза:
var r: HashSet<int> := [ 1, 2, 3, 4 ];
// нужно выбрать 2 числа
// каждое число из 5 цифр → 10 / 5 = 2
var n := r.Sum() div 5;
// перебираем все комбинации из 2-х чисел:
foreach var combo in GetCombinations(squares.toArray, n) do begin
var combined := string.Join('', combo);
var counter := combined.GroupBy(c -> c)
.ToDictionary(g -> g.Key, g -> g.Count());
// проверяем: множество частот должно совпадать с {1, 2, 3, 4}
if counter.Values.ToHashSet().SetEquals(r) then begin
var sortedChosen := combo.OrderBy(x -> x);
var notChosen := squares.Except(combo).OrderBy(x -> x);
// печатаем ответ для Тома:
var str := string.Join(', ', sortedChosen);
Writeln($' Том выбрал: {str}');
str := string.Join(', ', notChosen);
Writeln($' Том не выбрал: {str}');
Writeln;
end;
end;
end;

284

begin
Writeln(' Enigma 1504: All ten digits');
Writeln;
// отвечаем на вопрос 1:
Harry();
// отвечаем на вопрос 2:
Tom();
end.

Не будем крутить динаму и торпеду, а категорично запустим программу.
Что мы видим – ни словами сказать, ни пером описать. Это надо просто видеть в упор глазами лёжа:
Enigma 1504: All ten digits
Гарри: 101^2 = 10201
Гарри: 102^2 = 10404
Гарри: 111^2 = 12321
Гарри: 149^2 = 22201
Гарри: 152^2 = 23104
Гарри: 179^2 = 32041
Гарри: 182^2 = 33124
Гарри: 201^2 = 40401
Гарри выбрал: 10201, 10404, 12321, 23104, 32041, 33124, 40401
Гарри не выбрал: 22201
Том: 236^2 = 55696
Том: 264^2 = 69696
Том: 313^2 = 97969
Том: 314^2 = 98596
Том: 316^2 = 99856
Том выбрал: 55696, 97969
Том не выбрал: 69696, 98596, 99856

И тут, и тогда вы должны оценить порядочную сложность задачи для решения. А ведь её ещё нужно было придумать…

285

Проект Enigma 1518: Sets of squares
Исходный код программы находится в файле Sets of squares.pas.

В журнале New Scientist #2680 от 1-го октября 2008 года была напечатана
задача Enigma 1518:
Задача номер 1518 называется Sets of squares.
(1) Find the set of perfect squares that between them use each of the digits 1 to 9
exactly once whose sum is as small as possible. What is the sum of your set of
squares?
(2) Find the set of perfect squares that between them use each of the digits 0 to 9
exactly once whose sum is as small as possible. (Note: 0 must be used as a digit in a
square, not as a square by itself and not as a leading digit). What is the sum of your
set of squares?
По-русски её смысл можно передать такими словами.
(1) Найдите множество квадратов чисел, в которых каждая цифра от 1 до
9 встречается ровно 1 раз, с наименьшей суммой.
Какова сумма квадратов этого множества?
(2) Найдите множество квадратов чисел, в которых каждая цифра от 0 до
9 встречается ровно 1 раз, с наименьшей суммой.
(Примечание: 0 должен использоваться как цифра в квадрате, а не как самостоятельный квадрат и не как первая цифра)
Какова сумма квадратов этого множества?
Как говорится, или пан, или пан дигитальных чисел. Первый про пан для
нас неприемлем, а второй – как раз про нас.
286

Эта задача снова возвращает нас к пандигитальной теме, от которой мы
далеко и не отходили, а всегда были рядом или около.
Цельная проблема скверов состоит из двух частей, которые ясно и очевидно решаются одинаково, исключая проверку квадратов – то ли есть
нуль, а то ли его нет.
Для каждой части программистского дела нам нужно найти набор, или множество квадратов чисел без повторяющихся цифр (то есть все цифры в
наборе должны быть разными).
В целом числа в наборе должны содержать все цифры от единицы до девяти – первый случай, или от нуля до девяти – второй случай. Если таких
наборов окажется несколько, то нужно напечатать набор с наименьшей
суммой чисел. Надеюсь, я всё верно и понятно объяснил.
С некоторым напряжением и напрягом мыслей мы напишем одну процедуру Solve для решения обеих задач.
Она получит от нас число n и функцию для проверки чисел - Check или
Check0.
Uses MathExtensions;

// ЕСТЬ ЛИ В СТРОКЕ ПОВТОРЯЮЩИЕСЯ ЦИФРЫ
function Check(s: string): bool;
begin
var distinctChars := s.Distinct().ToList();
Result := distinctChars.Count <> s.Length;
end;
// ЕСТЬ ЛИ В СТРОКЕ НУЛЬ ИЛИ ПОВТОРЯЮЩИЕСЯ ЦИФРЫ
function Check0(s: string) := s.Contains(‘0’) or Check(s);

В первую очередь, мы собираем в список squares квадраты чисел, прошедших проверку в вышеназванных функциях:
// РЕШАЕМ ЗАДАЧУ
287

procedure Solve(n: int64; check: Func<string, boolean>);
begin
var minSum: int64:= 0;
Writeln($' Решение для n = {n}');
// cобираем в список все квадраты <= n,
// удовлетворяющие условию check
var squares := new List<string>();
var i: int64 := 1;
while true do begin
var sq: int64 := i * i;
if sq > n then break;
var s := sq.ToString();
if check(s) then begin
i += 1;
continue;
end;
squares.Add(s);
i += 1;
end;

Простота закончилась, и началась труднота. Нам нужно по-взрослому решать задачу. В множество targetDigits забиваем заданные цифры, а переменная minSum сохранит минимальную сумму квадратов чисел, то есть ответ на задачу:
// заданные цифры:
var targetDigits := new HashSet<char>(n.ToString().ToCharArray());
minSum := 0;

Отправляем все материалы дела в функцию Find, от которой в переменной
minSum получим числовой ответ на задачу. Но если задача решения не
имеет, то переменная minSum сохранит значение 0.
Функция Find рекурсивная, поэтому трудна для понимания. Простой смысл
её заключается в том, чтобы собрать набор квадратов чисел из списка
squares, в котором содержатся все заданные цифры. Если такой набор будет найден, мы проверим, лучше ли он текущего рекорда в переменной
288

minSum. Если это так, мы обновим рекорд и напечатаем новый рекорд на
экране:
// решаем задачу:
Find(targetDigits, new List<int64>(), 0, squares, minSum);

// РЕКУРСИВНАЯ ФУНКЦИЯ - ИЩЕТ КОМБИНАЦИИ КВАДРАТОВ ДЛЯ ЗАДАННОГО НАБОРА
ЦИФР
procedure Find(digits: HashSet<char>;
sqs: List<int64>;
i: integer;
squares: List<string>;
var minSum: int64);
begin
// все цифры имеются — обновляем минимум:
if digits.Count = 0 then begin
var sum := sqs.Sum();
if (minSum = 0) or (sum < minSum) then begin
minSum := sum;
var s := string.Join(', ', sqs);
Writeln($' {s} => {sum}');
end;
exit;
end;
// перебираем квадраты, начиная с индекса i:
for var j := i to squares.Count - 1 do begin
var sq := squares[j];
// если длина квадрата больше,
// чем осталось цифр, то дальше не ищем
if sq.Length > digits.Count then break;
// gроверяем, что все цифры квадрата содержатся в оставшихся цифрах:
if not sq.All(digits.Contains) then continue;
// hекурсивно продолжаем поиск, убрав использованные цифры:
var remainingDigits := new HashSet<char>(digits.Except(sq.ToCharArray()));
var newSqs := new List<int64>(sqs);
newSqs.Add(StrToInt64(sq));
289

Find(remainingDigits, newSqs, j + 1, squares, minSum);
end;
end;

Если в результате самоотверженной работы функции Find переменная
minSum получит положительное значение, то задача решена:
// печатаем ответ
if minSum <> 0 then
Writeln($' min({n}) = {minSum}')
else
Writeln($' min({n}) = не найдено');
Writeln;
end;

С некоторым трудовым трепетом в груди запускаем программу. Ан нет, всё
нормуль: задача разрешена в двух ипостасях.
В первом случае нужно взять квадраты 1, 9, 25, 36, 784 с суммой 855. Во
втором – квадраты 324, 576, 1089 с суммой 1989.
Вот тебе задача!
Enigma 1518: Sets of squares
Решение для n = 987654321
1, 4, 9, 872356 => 872370
1, 9, 25, 36, 784 => 855
min(987654321) = 855
Решение для n = 9876543210
1, 4, 9, 36, 87025 => 87075
1, 9, 784, 30625 => 31419
1, 36, 784, 9025 => 9846
9, 16, 784, 3025 => 3834
9, 81, 576, 2304 => 2970
324, 576, 1089 => 1989
min(9876543210) = 1989

290

Проект Задача Крайчика #3
Исходный код программы находится в файле Задача Крайчика
#3.pas.
В известной книге бельгийского математика Мориса Крайчика (Maurice
Kraitchik, родился в Минске) Mathematical recreations есть раздел, посвящённый криптарифмам.

Мы решим одну задачу из этой книги:
Задача номер 3 называется Oder. Вы найдёте ею на странице 82.

291

Задача необыкновенно простая и легко решается по аналогии с предыдущими задачами. Мы только должны учесть, что в криптарифме всего 4 неизвестные буквы:
{$reference GenericsCombinatorics.dll}
uses Facet.Combinatorics;
// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
var arr := Range(0, 9).ToArray();
var vars := new Variations<integer>(arr, 4, GenerateOption.WithoutRepetition);
var num := 0;
foreach var v in vars do begin
var o := v[0];
if (o = 0) then continue;
var d := v[1];
if (d = 0) then continue;
var e := v[2];
var r := v[3];
var oder := ((o * 10 + d) * 10 + e) * 10 + r;
if oder <> 18*(d*10 + o + o*10+r) then continue;
// нашли решение:
Writeln($' ODER = {o}{d}{e}{r}');
num += 1;
end;
Writeln($' Всего решений: {num}');
Writeln;
end;

begin
Writeln(' Задача Крайчика #3');
Writeln;
Solve();
end.

И вот единственное решение этой задачи:
292

Задача Крайчика #3
ODER = 1926
Всего решений: 1

Проект Задача Мадахи #22
Исходный код программы находится в файле Задача Мадахи #22.pas.

В не менее известной книге Джозефа Мадахи (Joseph S. Madachy) Mathematics on vacation вся седьмая глава отдана рассказу о криптарифмах.

Большинство криптарифмов – известные классические задачи, но в одной
нужно извлечь квадратный корень:
293

Задача номер 22 называется Rut. Вы найдёте ею на странице 191.

Задача простая, но при проверке чисел мы заменим извлечение корня в левой части равенства возведением в квадрат его в правой части.
{$reference GenericsCombinatorics.dll}
uses Facet.Combinatorics;
// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
var arr := Range(0, 9).ToArray();
var vars := new Variations<integer>(arr, 6, GenerateOption.WithoutRepetition);
var num := 0;
foreach var v in vars do begin
var c := v[0];
if (c = 0) then continue;
var r := v[1];
if (r = 0) then continue;
var a := v[2];
var e := v[3];
var u := v[4];
var t := v[5];
var career := ((((c * 10 + a) * 10 + r) * 10 + e)*10 + e)*10 + r;
var rut := (r * 10 + u) * 10 + t;
if (rut * rut <> career) then continue;
// нашли решение:
Writeln($' CAREER = {c}{a}{r}{e}{e}{r}');
Writeln($' RUT = {r}{u}{t}');
num += 1;
end;
Writeln($' Всего решений: {num}');
Writeln;
end;
294

begin
Writeln(' Задача Мадахи #22');
Writeln;
Solve();
end.

Задача Мадахи решена:
Задача Мадахи #22
CAREER = 376996
RUT = 614
Всего решений: 1

Проект Задача Мартина Гарднера
Исходный код программы находится в файле Задача Мартина Гарднера.pas.
И одна из лучших книг Мартина Гарднера Математические досуги не обошла вниманием криптарифмы.

295

В одной из них также нужно извлечь квадратный корень.
Задача номер 5 называется Wonderful. Вы найдёте ею на странице 66.

В слове WONDERFUL – 9 разных букв, поэтому для решения задачи потребуется некоторое время. Других трудностей и в этой задаче нет.
{$reference GenericsCombinatorics.dll}
uses Facet.Combinatorics;
// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
var arr := Range(0, 9).ToArray();
var vars := new Variations<integer>(arr, 9, GenerateOption.WithoutRepetition);
var num := 0;
foreach var v in vars do begin
var w := v[0];
if (w = 0) then continue;
var o := v[1];
if (o = 0) then continue;
296

var
var
var
var
var
var
var

n
d
e
r
f
u
l

:=
:=
:=
:=
:=
:=
:=

v[2];
v[3];
v[4];
v[5];
v[6];
v[7];
v[8];

var wonderful := (((((((w * 10 + o) * 10 + n) * 10 + d) * 10 + e) *
10 + r)*10 + f)*10 + u)*10 + l;
var ooddf := (((o * 10 + o) * 10 + d)*10 +d)*10 + f;
if (ooddf * ooddf <> wonderful) then continue;
// нашли решение:
Writeln($' WONDERFUL = {w}{o}{n}{d}{e}{r}{f}{u}{l}');
Writeln($' OODDF = {o}{o}{d}{d}{f} ');
num += 1;
end;
Writeln($' Всего решений: {num}');
Writeln;
end;

begin
Writeln(' Задача Мартина Гарднера');
Writeln;
Solve();
end.

Прекрасная задача распрекрасно решена:
Задача Мартина Гарднера
WONDERFUL = 523814769
OODDF = 22887
Всего решений: 1

297

Проект Высокая степень искусства
Исходный код программы находится в файле Высокая степень искусства.pas.
Число 81 обладает интересной особенностью. Если сумму его цифр возвести в квадрат, то оно же и получится:
(8+1)2 = 81
Двузначных чисел подобного рода больше нет, а трёхзначное число только
одно. Его можно найти и ручным счётом, но как вы относитесь к 18- и более
значным числам? Например, не самое большое число, которое нам вскоре
предстоит найти, вот такое страшное-престрашное:
5728074323261865147583203450623410328657806917765607180144627106058056117
6768011743674603909430893303748991673128983063946133540401714270017038345
9601690707505549445405196125257706023122381146601014719496694543369193737
99537200070656 =
(5+7+2+8+0+7+4+3+2+3+2+6+1+8+6+5+1+4+7+5+8+3+2+0+3+4+5+0+6+2+3+4+1+0+3+2+
8+6+5+7+8+0+6+9+1+7+7+6+5+6+0+7+1+8+0+1+4+4+6+2+7+1+0+6+0+5+8+0+5+6+1+1+7
+6+7+6+8+0+1+1+7+4+3+6+7+4+6+0+3+9+0+9+4+3+0+8+9+3+3+0+3+7+4+8+9+9+1+6+7+
3+1+2+8+9+8+3+0+6+3+9+4+6+1+3+3+5+4+0+4+0+1+7+1+4+2+7+0+0+1+7+0+3+8+3+4+5
+9+6+0+1+6+9+0+7+0+7+5+0+5+5+4+9+4+4+5+4+0+5+1+9+6+1+2+5+2+5+7+7+0+6+0+2+
3+1+2+2+3+8+1+1+4+6+6+0+1+0+1+4+7+1+9+4+9+6+6+9+4+5+4+3+3+6+9+1+9+3+7+3+7
+9+9+5+3+7+2+0+0+0+7+0+6+5+6)78

Ворочать числами мы, безусловно, поручим компьютеру, ну а нам самим
придётся немного поворочать мозгами.
Дабы не мучать программу многочисленными запусками, организуем «бесконечный» ввод данных – показатель степени n (от двух до ста), в которую
нужно возвести изрядный ряд чисел:
begin
Writeln(' Высокая степень искусства');
298

Writeln;
// бесконечный цикл ввода данных // пока пользователь не закроет программу:
repeat
var num := ReadInteger(' Введите степень
Solve(num);
until not (true);
end.

>');

Для работы с большими числами я написал отдельный модуль
BigIntegerExtensions, так что процедура Solve получилась короткой и ясной, как лунная ночь:
uses BigIntegerExtensions;

// РЕШАЕМ ЗАДАЧУ
procedure Solve(n: integer);
begin

Если мы ограничимся поиском не более чем 100-значных чисел, то сумма
цифр в любом из них заведомо меньше тысячи, но для круглости мы поставим тысячу. Для минимальной суммы цифр мы запишем двойку, хотя это
явное преуменьшение:
for var i := 2 to 1000 do begin

Теперь мы последовательно возводим в степень n все числа от 2 до 1000.
То есть находим заданную степень соответствующих сумм цифр. Например,
если показатель степени n=2, то при i = 9 степень окажется равной 81. Степень мы вычисляем с помощью метода Pow класса BigInteger:
var

power := BigInteger.Pow(i, n);

Итак, у нас в руках оказалась степень числа in. Если число power решает
нашу задачу, то сумма его цифр sum должна равняться числу i. Находим её
299

и сравниваем эти два числа. Если они «сходятся», то решение найдено, и мы
печатаем строку со всеми арифметическими выкладками на экране:
// сумма цифр числа:
var sum := power.DigitSumBig;
if (sum = i) then begin
var s := string.Join('+', power.GetDigitsBig);
Writeln($' {power} = ({s})^{n}');
end;
end;
Writeln;
end;

Остепенились по полной программе!
Высокая степень искусства
Введите степень
81 = (8+1)^2

> 2

Введите степень > 3
512 = (5+1+2)^3
4913 = (4+9+1+3)^3
5832 = (5+8+3+2)^3
17576 = (1+7+5+7+6)^3
19683 = (1+9+6+8+3)^3
Введите степень > 4
2401 = (2+4+0+1)^4
234256 = (2+3+4+2+5+6)^4
390625 = (3+9+0+6+2+5)^4
614656 = (6+1+4+6+5+6)^4
1679616 = (1+6+7+9+6+1+6)^4
Введите степень > 5
17210368 = (1+7+2+1+0+3+6+8)^5
52521875 = (5+2+5+2+1+8+7+5)^5
60466176 = (6+0+4+6+6+1+7+6)^5
205962976 = (2+0+5+9+6+2+9+7+6)^5
Введите степень

> 6
300

34012224 = (3+4+0+1+2+2+2+4)^6
8303765625 = (8+3+0+3+7+6+5+6+2+5)^6
24794911296 = (2+4+7+9+4+9+1+1+2+9+6)^6
68719476736 = (6+8+7+1+9+4+7+6+7+3+6)^6
Введите степень > 7
612220032 = (6+1+2+2+2+0+0+3+2)^7
10460353203 = (1+0+4+6+0+3+5+3+2+0+3)^7
27512614111 = (2+7+5+1+2+6+1+4+1+1+1)^7
52523350144 = (5+2+5+2+3+3+5+0+1+4+4)^7
271818611107 = (2+7+1+8+1+8+6+1+1+1+0+7)^7
1174711139837 = (1+1+7+4+7+1+1+1+3+9+8+3+7)^7
2207984167552 = (2+2+0+7+9+8+4+1+6+7+5+5+2)^7
6722988818432 = (6+7+2+2+9+8+8+8+1+8+4+3+2)^7
Введите степень > 8
20047612231936 = (2+0+0+4+7+6+1+2+2+3+1+9+3+6)^8
72301961339136 = (7+2+3+0+1+9+6+1+3+3+9+1+3+6)^8
248155780267521 = (2+4+8+1+5+5+7+8+0+2+6+7+5+2+1)^8
Введите степень > 9
3904305912313344 = (3+9+0+4+3+0+5+9+1+2+3+1+3+3+4+4)^9
45848500718449031 = (4+5+8+4+8+5+0+0+7+1+8+4+4+9+0+3+1)^9
150094635296999121 = (1+5+0+0+9+4+6+3+5+2+9+6+9+9+9+1+2+1)^9
Введите степень > 10
13744803133596058624 = (1+3+7+4+4+8+0+3+1+3+3+5+9+6+0+5+8+6+2+4)^10
19687440434072265625 = (1+9+6+8+7+4+4+0+4+3+4+0+7+2+2+6+5+6+2+5)^10
53861511409489970176 = (5+3+8+6+1+5+1+1+4+0+9+4+8+9+9+7+0+1+7+6)^10
73742412689492826049 = (7+3+7+4+2+4+1+2+6+8+9+4+9+2+8+2+6+0+4+9)^10
179084769654285362176 = (1+7+9+0+8+4+7+6+9+6+5+4+2+8+5+3+6+2+1+7+6)^10
480682838924478847449 = (4+8+0+6+8+2+8+3+8+9+2+4+4+7+8+8+4+7+4+4+9)^10
Введите степень > 11
8007313507497959524352 =
(8+0+0+7+3+1+3+5+0+7+4+9+7+9+5+9+5+2+4+3+5+2)^11
21048519522998348950643 =
(2+1+0+4+8+5+1+9+5+2+2+9+9+8+3+4+8+9+5+0+6+4+3)^11
23316389970546096340992 =
(2+3+3+1+6+3+8+9+9+7+0+5+4+6+0+9+6+3+4+0+9+9+2)^11
Введите степень > 12
2518170116818978404827136 =
(2+5+1+8+1+7+0+1+1+6+8+1+8+9+7+8+4+0+4+8+2+7+1+3+6)^12
301

А вот и страшное число, которым я пугал вас в начале проекта!
Введите степень

> 78

5728074323261865147583203450623410328657806917765607180144627106058056117
6768011743674603909430893303748991673128983063946133540401714270017038345
9601690707505549445405196125257706023122381146601014719496694543369193737
99537200070656 =
(5+7+2+8+0+7+4+3+2+3+2+6+1+8+6+5+1+4+7+5+8+3+2+0+3+4+5+0+6+2+3+4+1+0+3+2+
8+6+5+7+8+0+6+9+1+7+7+6+5+6+0+7+1+8+0+1+4+4+6+2+7+1+0+6+0+5+8+0+5+6+1+1+7
+6+7+6+8+0+1+1+7+4+3+6+7+4+6+0+3+9+0+9+4+3+0+8+9+3+3+0+3+7+4+8+9+9+1+6+7+
3+1+2+8+9+8+3+0+6+3+9+4+6+1+3+3+5+4+0+4+0+1+7+1+4+2+7+0+0+1+7+0+3+8+3+4+5
+9+6+0+1+6+9+0+7+0+7+5+0+5+5+4+9+4+4+5+4+0+5+1+9+6+1+2+5+2+5+7+7+0+6+0+2+
3+1+2+2+3+8+1+1+4+6+6+0+1+0+1+4+7+1+9+4+9+6+6+9+4+5+4+3+3+6+9+1+9+3+7+3+7
+9+9+5+3+7+2+0+0+0+7+0+6+5+6)^78

Проект Числа Армстронга
Исходный код программы находится в файле Числа Армстронга.pas.

n-значное число называется числом Армстронга, если оно равно сумме nых степеней своих цифр. Первое число Армстронга – 153. Проверим это
утверждение:
13 + 53 + 33 = 1 + 125 + 27 = 153
Всё верно!
Первые девять натуральных чисел 1..9 формально также
являются числами Армстронга, но они слишком тривиальны, чтобы быть интересными.
302

По-английски такие числа называют Armstrong numbers
или Pluperfect Digital Invariants – PPDIs.
Другое название этих чисел – нарциссические (Narcissic
numbers). Оно восходит к самовлюблённому Нарциссу и
обыгрывает тот факт, что числа Армстронга так любят
себя, что сумма степеней их цифр равняется им самим.

Всего существует 88 чисел Армстронга (для десятичной системы счисления). Первое из них, как мы уже знаем. Это 153. Мы легко найдём и несколько следующих: 370, 371, 407. Но самое большое состоит из 39 цифр,
так что потрудиться нам предстоит немало. И вот почему. Несмотря на
внешнюю схожесть наших предыдущих степенных чисел и чисел Армстронга, последние отыскать куда сложнее. С другой стороны, степень
суммы натуральных чисел всегда больше суммы их степеней, поэтому числа
Армстронга заканчиваются уже на 39-й степени, а в предыдущем проекте
мы добрались, по крайней мере, до 78-й!
А вот полный список чисел Армстронга:
№

n

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

3
3
3
3
4
4
4
5
5
5
6
7
7
7
7

Число Армстронга
153
370
371
407
1634
8208
9474
54748
92727
93084
548834
1741725
4210818
9800817
9926315
303

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58

8
8
8
9
9
9
9
10
11
11
11
11
11
11
11
11
14
16
16
17
17
17
19
19
19
19
20
21
21
23
23
23
23
23
24
24
24
25
25
25
25
25
27

24678050
24678051
88593477
146511208
472335975
534494836
912985153
4679307774
32164049650
32164049651
40028394225
42678290603
44708635679
49388550606
82693916578
94204591914
28116440335967
4338281769391370
4338281769391371
21897142587612075
35641594208964132
35875699062250035
1517841543307505039
3289582984443187032
4498128791164624869
4929273885928088826
63105425988599693916
128468643043731391252
449177399146038697307
21887696841122916288858
27879694893054074471405
27907865009977052567814
28361281321319229463398
35452590104031691935943
174088005938065293023722
188451485447897896036875
239313664430041569350093
1550475334214501539088894
1553242162893771850669378
3706907995955475988644380
3706907995955475988644381
4422095118095899619457938
121204998563613372405438066
304

59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79

27
27
27
27
29
29
29
29
31
31
31
32
33
33
34
35
35
37
38
39
39

121270696006801314328439376
128851796696487777842012787
174650464499531377631639254
177265453171792792366489765
14607640612971980372614873089
19008174136254279995012734740
19008174136254279995012734741
23866716435523975980390369295
1145037275765491025924292050346
1927890457142960697580636236639
2309092682616190307509695338915
17333509997782249308725103962772
186709961001538790100634132976990
186709961001538790100634132976991
1122763285329372541592822900204593
12639369517103790328947807201478392
12679937780272278566303885594196922
1219167219625434121569735803609966019
12815792078366059955099770545296129367
115132219018763992565095597973971522400
115132219018763992565095597973971522401

В таблицу не включены первые девять чисел Армстронга:
1..9.
Для некоторых степеней числа Армстронга отсуствуют.

Числа Армстронга против грубой силы
Сила есть – ума не надо.
Такая пословица

Попробуем взять числа Армстронга недолго думая, что нам вполне удалось
с предыдущими числами.
Пусть нам нужно найти числа Армстронга, которые состоят из n цифр. Мы
последовательно перебираем все числа от 10n-1 до 10n-1 и для каждого
находим сумму n-ной степени его цифр. Если она совпадёт с исходным числом, значит, число Армстронга найдено!
305

Для простоты программирования я добавил в модуль BigIntegerExtensions
два метода расширения:
/// ВОЗВРАЩАЕТ КАЖДУЮЦИФРУ ЧИСЛА В ЗАДАННОЙ СТЕПЕНИ
function GetDigitPowersBig(self: BigInteger; power: integer): sequence of
BigInteger; extensionmethod;
begin
foreach var digit in self.GetDigitsBig do
yield BigInteger.Pow(digit, power);
end;
/// ВОЗВРАЩАЕТ TRUE, ЕСЛИ ЧИСЛО АРМСТРОНГА
function IsArmstrongNumber(self: BigInteger; power: integer): boolean; extensionmethod;
begin
var sum := self.GetDigitPowersBig(power).Sum;
Result := sum = self;
end;

В результате некоторых мозговых усилий и рукоприкладства программа
получилась!
uses MathExtensions, BigIntegerExtensions;

// РЕШАЕМ ЗАДАЧУ
procedure Solve(n: integer);
begin
var a := 10.IPower(n-1);
var b := 10.IPower(n)-1;
for var i := a to b do begin
var num := BigInteger(i);
if num.IsArmstrongNumber(n) then
Writeln($' {num}');
end;
Writeln;
end;

begin
Writeln(' Числа Армстронга');
Writeln;
306

// бесконечный цикл ввода данных // пока пользователь не закроет программу:
repeat
var num := ReadInteger(' Введите длину чисел (3..9)
Solve(num);
until not (true);
end.

>');

Как учит нас правило рычага, если в одном месте что-то короче, то в другом
длиннее. Программа короткая, но работает долго, поэтому я набрался
ждучести только до 8-значных чисел:
Числа Армстронга
Введите длину чисел (3..9)
153
370
371
407

> 3

Введите длину чисел (3..9)
1634
8208
9474

> 4

Введите длину чисел (3..9)
54748
92727
93084

> 5

Введите длину чисел (3..9)
548834

> 6

Введите длину чисел (3..9)
1741725
4210818
9800817
9926315

> 7

Введите длину чисел (3..9)
24678050
24678051

> 8

307

88593477

В этом «лобовом» алгоритме нас особенно должно возмутить постоянное
возведение в степень n одних и тех же чисел 0..9, из которых и состоят все
подозреваемые в нарциссизме числа. Поэтому мы несколько ускорим перебор, если сразу же создадим таблицу степеней 2..39 этих чисел, а при
нахождении суммы степеней будем просто извлекать нужную степень из
массива. Больше ничего хорошего от метода грубой силы ждать не приходится.
procedure Armstrong(n: integer);
begin
var BASE := 10;
var powTable := new int[BASE];
var start := 1;
for var i := 0 to BASE-1 do powTable[i] := i;
for var i := 1 to n-1 do begin
start *= BASE;
for var k := 0 to BASE-1 do powTable[k] *= k;
end;
for var bi := start to start * 10-1 do begin
var sum := 0;
var num := bi;
var digit := 0;
// сумма степеней цифр числа:
while (num > 0) do begin
digit := num mod BASE;
sum += powTable[digit];
// сумма больше исходного числа:
if (sum > bi) then break;
num := num div BASE;
end;
// нашли число Армстронга:
if (num = 0) and (sum = bi) then
Writeln($' {bi}');
end;
Writeln;
end;
308

Смотрим код и результат его работы для 9-значных чисел:
Введите длину чисел (3..9)
146511208
472335975
534494836
912985153

> 9

Для 3-9-значных чисел необходимо перебрать миллиард чисел, и на это уйдёт около 30 секунд времени. Дальше счёт пойдёт на минуты. Если у вас
много свободного времени, то вы сможете продвинуться ещё на пару степеней, но тут уж вам придётся заменить тип данных integer более длинным –
Int64. Сделать это несложно, но грубый алгоритм работает слишком медленно. Неспешность нашего алгоритма объясняется тем, что он по нескольку раз находит сумму степеней одних и тех же чисел. Действительно,
многие числа состоят из одинаковых цифр. Например:
135
153
315
351
513
531
И чем больше в числах цифр, тем больше среди них «анаграмматических».
Но для всей группы таких чисел сумма степеней цифр одинакова, поскольку
одинаковы и сами цифры, а мы вычисляем эту сумму для каждого числа отдельно! Для чисел, состоящих из цифр 1,3,5, - целых 6 раз! Для разработки
нового алгоритма необходимо генерировать все подмножества с повторениями (мультимножества) множества цифр {0,1,2,3,4,5,6,7,8,9}. Для
нашего примера достаточно проверить подмножество цифр {1,3,5}. Ясно,
что из всех чисел, которые можно составить из этих цифр, только одно может быть числом Армстронга (а может и не быть!). К сожалению, программа, реализующая умный алгоритм, гораздо сложнее, поэтому мы удовлетворимся числами Армстронга, состоящими не более чем из девяти
цифр.
309

Словесные дистанции
Мы уже с пользой использовали динамическое программирование для
решения задач. Оно нам надо, поэтому давайте окунёмся в него глубже!
Ошибки совершают все люди, но некоторые из них делают это с особым
удовольствием. Например, так:
1. печатать русские слова латинскими буквами (транслитерация); такие ляпсусы часто появляются при переключении клавиатуры с одного
языка на другой:
ПОЛЕ → GJKT, ПОЛКА → GJKRF
2. переставлять буквы в словах (анаграммы):
ПОЛЕ → ПОЕЛ, РАБА → АРБА
3. заменять одни буквы другими (метаграммы):
ПОЛЕ → ПОЛО, РАБА → БАБА
4. недо/переписывать отдельные буквы (логогрифы):
ПОЛКА → ПОЛА, ПРУТ→ СПРУТ
Чаще всего подобные ошибки возникают при наборе текста на компьютере.
Я, например, едва ли не половину слов набиарю с ощибкеами. Это и понятно:
то соседние клавиши перепутаешь или нажмёшь их одновременно, то дважды стукнешь по одной и той же, то вообще пропустишь или недожмёшь…
Современные текстовые редакторы достаточно внимательны и сообразительны, чтобы отлавливать слова, которых нет в их словаре. Они считают
их ошибочными и подчёркивают красной волнистой линией, а особенно
услужливые программы даже предлагают на выбор список подходящих
слов для исправления.

310

По этому списку легко понять, что компьютер не может догадаться, какое
именно слово вы хотели написать и подбирает похожие на него, а уж выбирать нужное слово – это ваша задача.
Но вот что интересно: а как компьютер находит слова для своего списка? В
следующем проекте мы постараемся проникнуть в суть и глубь этого процесса.

Проект Алгоритм Левенштейна
Исходный код программы находится в файле Алгоритм Левенштейна.pas.
В 1965 году российский учёный Владимир Иосифович
Левенштейн ввёл понятие расстояние редактирования.
Он доказал, что одно слово можно превратить в другое с
помощью трёх операций: вставки, удаления и замены
одного символа. Возможно, эти операции (все или
только некоторые) придётся выполнить многократно.
Минимальное число операций, необходимых для этого,
и называется дистанцией Левенштейна.

311

Иначе его называют алгоритмом Левенштейна, дистанцией Левенштейна (Levenshtein distance) и функцией Левенштейна.
Роль слов могут исполнять строки, тексты, файлы, числа
– вообще любые последовательности, включая молекулы
ДНК.

Для поиска словесных двойняшек нам нужен словарь. Также нам удобнее
начинать индексацию букв в словах с нуля, чтобы сохранить преемственность с другими проектами:
{$zerobasedstrings}
var path := 'OSH-W97frc.txt';
var words: array of string;

Сразу, без промедления загружаем все слова в строковый массив words и
затеваем бесконечный цикл для ввода желаемых слов с клавиатуры. Я полагаю, что двойняшки различаются на 1 сущность, чтобы не получать ненужное детское (изо)обилие:
begin
Writeln(' Алгоритм Левенштейна');
Writeln;
words := ReadAllLines(path);
var n := 1;
while True do begin
var s := ReadString.ToUpper;
Lev(s, n);
end;
end.

312

Таким образом, пользователь сам определяет схожесть слов, которые
нужно подобрать к заданному слову s. Чем больше он задаст дистанцию Левенштейна, тем длиннее окажется список подходящих слов.
Для пользы дела нам потребны 2 функции.
Функция Min3 возвращает меньшее из трёх чисел:
function Min3(a, b, c: integer) := Min(Min(a, b), c);

А функция GetDistance возвращает дистанцию Левенштейна между двумя
заданными словами:
function
begin
var n
var m
if (n
if (m

GetDistance(s,t: string ): integer;
:= s.Length;
:= t.Length;
= 0) then exit(m);
= 0) then exit(n);

// вспомогательный массив:
var distance := new integer[n + 1, m + 1];
var cost := 0;
// заполняем массив исходными данными:
for var i := 0 to n do distance[i, 0] := i;
for var j := 0 to m do distance[0, j] := j;
// вычисляем минимальное расстояние между словами:
for var i := 1 to n do begin
for var j := 1 to m do begin
cost := (t.Substring(j - 1, 1) = s.Substring(i - 1, 1) ? 0 : 1);
distance[i, j] := Min3(distance[i - 1, j] + 1,
distance[i, j - 1] + 1,
distance[i - 1, j - 1] + cost);
end;
end;
Result := distance[n, m];
end;

313

И вот теперь пора и можно дерзить прямо в процедуре Lev, которая получает «ошибочное» слово и дистанцию Левештейна:
// ПОДБИРАЕМ БЛИЗКИЕ СЛОВА ДЛЯ s
procedure Lev(s: string; num: integer);
begin
var str := s + ' >';

Цикл foreach просматривает весь массив слов words и сравнивает каждое
слово w с заданным словом s, вызывая функцию GetDistance, которая и воплощает в жизнь весь алгоритм Левенштейна:
var flg := False;
// просматриваем весь список:
foreach var w in words do begin
var m := GetDistance(w, s);
// нашли похожее слово:
if (m = num) then begin
str += ' ' + w;
flg := True;
end;
end;
if (flg) then
Writeln($' {str}')
else
Writeln($' Похожих слов нет!');
Writeln;
end;

Давайте на примере разберём работу алгоритма. Пусть cлово s = ПОЛКА, а
слово t = ПОЛА. Длина первого слова n = 5, второго – m = 4. По этим данным
мы создаём пустой массив distance с пятью строками и шестью столбцами.
Затем в двух циклах for заполняем нулевую строку и колонку последовательными числами, начиная с нуля:

314

Таблица расстояний в исходном положении
Теперь пришла пора заполнить пустые (конечно, они не совсем пустые,
ведь в них стоят нули) клетки таблицы числами. Мы опять прибегаем к помощи двух циклов for. Внешний проходит по всем колонкам таблицы,
внутренний – по строкам. Для каждой клетки (i, j) мы вычисляем минимальное из трех чисел:
• distance[i - 1, j] + 1 – операция вставки символа
• distance[i, j - 1] + 1 – операция удаления символа
• distance[i - 1, j - 1] + cost - операция замены символа.
Если символы в одинаковых позициях обоих слов совпадают, то cost равняется нулю, в противном случае – единице. Здесь мы должны учесть, что
символы в строке нумеруются с нуля, а соответствующие клетки в массиве
– с единицы:
cost := (t.Substring(j - 1, 1) = s.Substring(i - 1, 1) ? 0 : 1);

315

Начнём с первой пустой клетки (1,1). Поскольку нулевые (по-русски - первые) символы в словах ПОЛА и ПОЛКА совпадают, то cost=0. Для этой
клетки мы должны получить такие значения:
distance[i - 1, j] + 1 → distance[0, 1] + 1- слева от клетки (1,1) = 2
distance[i, j - 1] + 1 → distance[1,0] + 1- сверху от клетки (1,1) = 2
distance[i - 1, j - 1] → distance[0,0] +0 – по диагонали вверх влево от клетки
(1,1) = 0
Теперь нужно минимальное из чисел 2,2,0, то есть нуль записываем в
клетку (1,1):

Нуль в первой клетке
Далее внутренний цикл переводит нас в клетку (1,2). Для неё мы вычисляем
значение аналогично – 3, 1, 2 → 1.

316

Единицу – в клетку ниже
Третьи буквы в словах также совпадают, поэтому продолжаем в том же
духе: 4, 2, 2 → 2.

Двойку – в клетку ниже
317

А вот четвёртые буквы разные, поэтому cost = 1: 5, 3, 4 → 3.

Тройку – в клетку ниже
Первую колонку мы заполнили сверху донизу – переходим ко второй колонке, и так далее – пока не заполним всю таблицу.

Таблица готова
318

Поскольку наши действия ничуть не меняются при нахождении значений
для новых клеток, то вы можете просчитать их самостоятельно.
Последней мы заполнили правую нижнюю клетку, поставив в неё единицу. Она и даёт нам ответ на вопрос, насколько отличаются два заданных
слова друг от друга. Как мы видим, достаточно одной операции, чтобы превратить одно слово в другое. Легко догадаться, что для перевода слова
ПОЛА в слово ПОЛКА следует вставить букву К между буквами Л и А. Для
обратного перевода достаточно удалить букву К из слова ПОЛКА. В трудных
случаях, когда строки имеют большую длину, вычислять дистанцию вручную, конечно, не очень весело, а так, с программой – одно сплошное удовольствие!
Запускаем программу и находим для заданных слов близких «родственников».
Алгоритм Левенштейна
кнока
КНОКА > КНОПКА
фоорма
ФООРМА > ФОРМА
поел
ПОЕЛ > ПОЛ
раба
РАБА > РАБ БАБА ЖАБА РАМА РАНА РАСА РОБА РЫБА
поле
ПОЛЕ > ПОЛ ПОЛА ПОЛК ПОЛО
полка
ПОЛКА > ПОЛА ПОЛК ЗОЛКА КОЛКА ПАЛКА ПИЛКА ПОЛБА ПОПКА ПОРКА ПОЧКА СОЛКА
ХОЛКА ПОИЛКА ПОЛЬКА
прут
ПРУТ > ПЛУТ ПРУД ТРУТ СПРУТ
валера
ВАЛЕРА > ГАЛЕРА
319

Проект Шестизначный перенос
Исходный код программы находится в файле Шестизначный перенос.pas.
Для начала и сугреву мы решим задачу 557 из книги
Математическая шкатулка, страница 94:
Первая слева цифра шестизначного числа – 1.
Если её перенести с первого места в конец числа,
сохранив порядок остальных цифр, то вновь полученное число будет втрое
больше первоначального.
Восстановите первоначальное число.

// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
// мин. и макс. 6-значные числа:
var min6 := 100000;
var max6 := 299999;
foreach var num in Range(min6, max6) do begin
// первая цифра числа:
var start := num div 100000;
// 5-значное число из последних 5 цифр числа num:
var end5 := num mod 100000;
// новое 6-значное число:
var newnum := end5 * 10 + start;
// это число должно быть втрое больше исходного:
if (newnum <> 3 * num) then
continue;
Writeln($' Число = {num}');
end;
320

Writeln;
end;

begin
Writeln(' Шестизначный перенос');
Writeln;
Solve();
end.

Среди 6-значных чисел, начинающихся с единицы, первоначальное число –
единственное. Есть ещё одно подобное число, но оно начинается с двойки:
Шестизначный перенос
Число = 142857
Число = 285714

Проект Найдите число
Исходный код программы находится в файле Найдите число.pas.

Эта задача вытекает из переборной задачи Шестизначный перенос, которую
мы решили в предыдущем проекте. Там мы искали число, которое увеличивается втрое при переносе первой цифры в конец числа.
В журнале Наука и жизнь, номер 6 за 1964 год, на странице 69 напечатана
интересная задача, которая похожа на Шестизначный перенос, но нужно переставить последнюю цифру - двойку - в начало числа. Казалось бы, разница небольшая, но это не так.

321

К счастью, в том же номере журнала приводится и ответ на эту задачу, который уберёг нас от перебора, ибо жизнь так коротка и прекрасна, что не
стоит тратить её на бездумный перебор.

Легко проверить, что это равенство верное:

Но для лучшего думания и понимания давайте запишем его иначе.

Теперь хорошо видно, что в исходном числе и в произведении совпадают
все цифры, кроме первой и последней. Более того, предпоследняя цифра исходного числа становится последней цифрой произведения. Третья цифра
322

сзади в исходном числе становится предпоследней цифрой в произведении.
И так далее до самой первой цифры исходного числа, которая занимает в
произведении второе место. И наконец, последняя цифра исходного числа
перебирается на первое место в произведении.
Чтобы сделать решение более универсальным, мы используем переменные:
krat – кратность увеличения нового числа при переносе последней цифры
lastnum.
Этот простой приём позволит нам обобщить задачу.
Также мы должны учесть, что число при переносе цифры не может увеличиться более чем в lastnum раз. Например, мы переносим двойку, и она занимает в произведении первое место. Эту двойку мы можем получить
только умножением единицы на двойку. Если бы число увеличилось в 3
раза, тогда при умножении единицы первой цифрой произведения была бы
не двойка, а тройка, что не согласуется с условиями задачи.
begin
Writeln(' Найдите число');
Writeln;
// последняя цифра:
var lastnum := 2;
// во сколько раз увеличивается число:
var krat := 0;
for var i := 2 to lastnum do begin
krat := i;
// число не может увеличиться
// более чем в lastnum раз:
if (krat > lastnum) then begin
Writeln($' Не выполняется условие krat <= lastnum!');
Writeln;
end
else Solve01(krat, lastnum);
end;
end.

323

Всё решение я перенёс в метод Solve01, в который мы передаём значения
переменных krat и lastnum.
uses MathExtensions;
// РЕШАЕМ ЗАДАЧУ
procedure Solve01(krat, lastnum: int);
begin

Также мы должны помнить, что задача имеет бесконечно много решений,
и мы поступим верно, если будем считать найденные решения и ограничимся только некоторыми из них.
// число решений:
var nSolution := 0;
// макс. число решений:
var maxSolution := 1;// 2;

Поскольку искомые числа очень большие, то для них нужны переменные
типа BigInteger. Сначала число n равно последней цифре числа lastnum.
Также нам нужны переменные nFirst и perenos:
// число:
var n := BigInteger(lastnum);
// первая цифра слева:
var nFirst := lastnum;
// перенос в следующий разряд:
var perenos := 0;

Итак, первоначально искомое число и его последняя (она же - первая)
цифра равны lastnum, то есть двойке, а перенос отсутствует.
Поскольку процесс вычисления многоступенчатый, то мы проводим его в
бесконечном цикле while:
324

// ищем числа в бесконечном цикле:
while (true) do begin

Давайте подумаем, как можно получить последнюю цифру произведения. А очень просто! По условию задачи, последняя цифра в исходном числе
– двойка. Также нам известно, что произведение в 2 раза больше исходного
числа, то есть мы должны умножить его на 2. Но тогда последняя 2 в исходном числе превратится в 4 в произведении. Но последняя цифра произведения – это предпоследняя цифра исходного числа.
Рассуждая аналогично, мы придём к выводу, что следующая цифра слева –
это 4 х 2 = 8, что мы и видим. Двигаемся далее: 8 x 2 = 16. Значит, перед
восьмёркой должна стоять шестёрка. Но обратите внимание, что в результате умножения мы получили число 16, и поэтому 1 должна перейти в следующий разряд. Тогда 6 x 2 + 1 = 13. Очередная цифра – 3, и мы имеем ещё
1 для следующего разряда.
Процесс прост и понятен, и мы можем продолжать его бесконечно. Однако
мы не кощеи бессмертные, поэтому обязаны вовремя остановиться. И остановиться мы должны тогда, когда в числе появится двойка без переноса в
следующий разряд. И тогда мы получим ещё не искомое число, а вот такое:

Чтобы избавиться от первой двойки, на бумаге достаточно просто зачеркнуть её, а в программе – вернуться к предыдущему числу.
По разработанному нами алгоритму мы находим следующую первую цифру
произведения nFirst, умножая текущую первую цифру на число krat и добавляя перенос.
Вычисляем перенос в следующий разряд.
// очередная первая цифра:
nFirst := nFirst * krat + perenos;
perenos := nFirst div 10;
325

И вот здесь нас подстерегает технологическая тонкость: если очередная
первая цифра окажется нулём, то мы не сможем поместить его в начале
числа, поскольку паскаль ведущий нуль не учитывает. Значит, в этом случае
мы должны сразу же найти и следующую первую цифру, которая должна
стоять перед нулём:
// если очередная первая цифра
// равна нулю, то
// сразу вычисляем следующую
// (перед ней):
nFirst := nFirst mod 10;
if (nFirst = 0) then begin
nFirst := perenos * 10;
perenos := 0;
end;

То есть мы одновременно находим 2 начальные цифры произведения. Перенос в следующий разряд, естественно, следует обнулить.
Такая неприятная ситуация может возникнуть, например, если krat равно
пяти, а очередная цифра искомого числа больше 1. Тогда мы получим: 2
(или 4, 6, 8) умножить на 5 равно 10. Обе эти цифры и следует поставить в
начало искомого числа.
Теперь мы можем вычислить текущее значение искомого числа. Пока оно
равно n, но мы должны поставить перед ним одну или две найденные
цифры nFirst. Для этого мы приписываем к ним нужное число нулей, а затем прибавляем текущее значение искомого числа:
// число десятичных разрядов в текущем числе:
var n10 := int(BigInteger.Log10(n) + 1);
// переносим первую цифру в начало числа:
var nShift := BigInteger(nFirst * BigInteger.Pow(10, n10));
// добавляем к текущему числу:
n += nShift;
// оставляем последнюю цифру:
if (nFirst >= 10) then
nFirst := nFirst div 10;
326

// число без последней цифры:
var nBezLast := BigInteger(n div 10);
// умножаем последнюю цифру:
n10 := int(BigInteger.Log10(n));
var nKrat := BigInteger(lastnum * BigInteger.Pow(10, n10));
// добавляем число без последней цифры:
var nNew := BigInteger(nKrat + nBezLast);

Проверяем не найдено ли решение. И в случае успеха, печатаем его на
экране.
if (nNew = n * krat) then begin
nSolution += 1;
Writeln($' Решение {nSolution}: {n} * {krat} = {nNew}');
// достаточно решений:
if (nSolution = maxSolution) then
break;
end;
end;
Writeln;
end;

Запускаем программу и тут же получаем 2 решения задачи.
Найдите число
Решение 1: 105263157894736842 * 2 = 210526315789473684
Решение 2: 105263157894736842105263157894736842 * 2 =
210526315789473684210526315789473684

Первое решение нам уже известно из журнала, а второе получается из первого простым повторением искомого числа. Точно так же вы можете «утроить» или «учетверить» короткое искомое число и получить новые решения.
Так как при переносе двойки число может увеличиться только в 2 раза, то
никаких других решений для книжной задачи не существует.
327

Если последняя цифра числа тройка, то число может увеличиться в 2 или 3
раза:
157894736842105263 * 2 = 315789473684210526
1034482758620689655172413793 * 3 = 3103448275862068965517241379
Для четвёрки мы получим 3 решения:
210526315789473684 * 2 = 421052631578947368
1379310344827586206896551724 * 3 = 4137931034482758620689655172
102564 * 4 = 410256
Для пятёрки - 4 решения:
263157894736842105 * 2 = 526315789473684210
1724137931034482758620689655 * 3 = 5172413793103448275862068965
128205 * 4 = 512820
102040816326530612244897959183673469387755 * 5 =
510204081632653061224489795918367346938775
Для шестёрки - 5 решений:
315789473684210526 * 2 = 631578947368421052
2068965517241379310344827586 * 3 = 6206896551724137931034482758
153846 * 4 = 615384
122448979591836734693877551020408163265306 * 5 =
612244897959183673469387755102040816326530
1016949152542372881355932203389830508474576271186440677966 * 6 =
6101694915254237288135593220338983050847457627118644067796
Для семёрки - 6 решений:
368421052631578947 * 2 = 736842105263157894
2413793103448275862068965517 * 3 = 7241379310344827586206896551
179487 * 4 = 717948
142857 * 5 = 714285
1186440677966101694915254237288135593220338983050847457627 *
7118644067796610169491525423728813559322033898305084745762

6

=
328

1014492753623188405797 * 7 = 7101449275362318840579
Для восьмёрки - 7 решений:
421052631578947368 * 2 = 842105263157894736
2758620689655172413793103448 * 3 = 8275862068965517241379310344
205128 * 4 = 820512
163265306122448979591836734693877551020408 * 5 =
816326530612244897959183673469387755102040
1355932203389830508474576271186440677966101694915254237288 * 6 =
8135593220338983050847457627118644067796610169491525423728
1159420289855072463768 * 7 = 8115942028985507246376
1012658227848 * 8 = 8101265822784
Для девятки - 8 решений:
473684210526315789 * 2 = 947368421052631578
3103448275862068965517241379 * 3 = 9310344827586206896551724137
230769 * 4 = 923076
183673469387755102040816326530612244897959 * 5 =
918367346938775510204081632653061224489795
1525423728813559322033898305084745762711864406779661016949 * 6 =
9152542372881355932203389830508474576271186440677966101694
1304347826086956521739 * 7 = 9130434782608695652173
1139240506329 * 8 = 9113924050632
10112359550561797752808988764044943820224719 * 9 =
91011235955056179775280898876404494382022471
Любопытно, что некоторые искомые числа можно отыскать среди дробей:
2/19
3/19
4/19
5/19
6/19
7/19
8/19
9/19

=
=
=
=
=
=
=
=

0.105263157894736842…
0.157894736842105263…
0.210526315789473684…
0.263157894736842105…
0.315789473684210526…
0.368421052631578947…
0.421052631578947368…
0.473684210526315789…
329

Так обычной точности не хватает для вычисления этих дробей, то мы используем тип Decimal:
procedure Solve;
begin
foreach var i in range(2,9) do begin
var n1 := Decimal(i);
var n2 := Decimal(19);
var n3 := (n1 / n2).ToString.Substring(2, 18);
Writeln(n3);
end;
Writeln;
end;

Легко заметить, что период всех дробей равен 18, поэтому, чтобы получить
целые числа, дроби следует умножить на 1018:
105263157894736842
157894736842105263
210526315789473684
263157894736842105
315789473684210526
368421052631578947
421052631578947368
473684210526315789
При переносе последней цифры в начало числа оно увеличится в 2 раза.
Аналогично можно найти числа, которые увеличиваются в 3 раза при переносе
последней цифры:
foreach var i in range(3,9) do begin
var n1 := Decimal(i);
var n2 := Decimal(29);
var n3 := (n1 / n2).ToString.Substring(2, 28);
Writeln(n3);
end;
Writeln;
330

1034482758620689655172413793
1379310344827586206896551724
1724137931034482758620689655
2068965517241379310344827586
2413793103448275862068965517
2758620689655172413793103448
3103448275862068965517241379
В 4 раза:
foreach var i in range(4,9) do begin
var n1 := Decimal(i);
var n2 := Decimal(39);
var n3 := (n1 / n2).ToString.Substring(2, 6);
Writeln(n3);
end;
Writeln;

102564
128205
153846
179487
205128
230769
В 5 раз:
102041
122449
142857
163265
183673
Точность типа Decimal ограничена 28-29-ью цифрами, поэтому добавим к
проекту библиотеку ExtendedNumerics.BigDecimal.
331

В 6 раз:
{$reference ExtendedNumerics.BigDecimal.dll}
uses ExtendedNumerics;
BigDecimal.Precision := 100;
foreach var i in range(6,9) do begin
var n1 := BigDecimal(i);
var n2 := BigDecimal(59);
var n3 := (n1 / n2).ToString.Substring(2, 58);
Writeln(n3);
end;
Writeln;

1016949152542372881355932203389830508474576271186440677966
1186440677966101694915254237288135593220338983050847457627
1355932203389830508474576271186440677966101694915254237288
1525423728813559322033898305084745762711864406779661016949
В 7 раз:
foreach var i in range(7,9) do begin
var n1 := BigDecimal(i);
var n2 := BigDecimal(69);
var n3 := (n1 / n2).ToString.Substring(2, 22);
Writeln(n3);
end;
Writeln;

1014492753623188405797
1159420289855072463768
1304347826086956521739
В 8 раз:
foreach
var
var
var

var i
n1 :=
n2 :=
n3 :=

in range(8,9) do begin
BigDecimal(i);
BigDecimal(79);
(n1 / n2).ToString.Substring(2, 13);
332

Writeln(n3);
end;
Writeln;

1012658227848
1139240506329
В 9 раз:
foreach var i in range(9,9) do begin
var n1 := BigDecimal(i);
var n2 := BigDecimal(89);
var n3 := (n1 / n2).ToString.Substring(2, 44);
Writeln(n3);
end;
Writeln;

10112359550561797752808988764044943820224719
Так как при переносе последней цифры n число увеличивается не более чем
в n раз, то общее количество чисел каждый раз уменьшается на 1. Числитель дроби равен последней цифре числа, а знаменатель – 19, 29, 39,…, 89,
то есть 10 * n – 1. А вот длину периода можно найти только опытным путём.

Проект Паразитические числа
Исходный код программы находится в файле Паразитические
числа.pas.
В англоязычной литературе рассмотренные нами в предыдущем проекте
числа называются паразитическими (parasitic numbers, parasite numbers).
Вы можете прочитать о них в книге Клиффорда Пиковера Wonders of Numbers Adventures in Mathematics, Mind, and Meaning, в Главе 80. Например, числа,
увеличивающиеся в 2 раза при переносе последней цифры, называются 2333

parasite. В 3 раза – 3-parasite. И так далее. Ассоциации цифр и чисел с биологическими паразитами слишком натянуты, чтобы принимать их всерьёз.

Настоящими паразитическими числами считаются такие, которые увеличиваются (или уменьшаются) в k раз, если последняя цифра n = k. Если k
отличается от n, то числа называются псевдопаразитическими
(pseudoparasite numbers, pseudoparasites).
Интересный материал о паразитных числах вы найдёте
также на сайте Wikipedia.

Пиковер предлагает вычислить дробь 137174210 / 1111111111 и найти в
ней что-то особенное.
Программа, понятно, очень простая:
334

{$reference ExtendedNumerics.BigDecimal.dll}
uses ExtendedNumerics;
uses MathExtensions;
// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin
BigDecimal.Precision := 50;
var n1 := BigDecimal(137174210);
var n2 := BigDecimal(1111111111);
var n3 := (n1 / n2);
Writeln(' ' + n3);
Writeln;
end;

begin
Writeln(' Паразитические числа');
Writeln;
Solve;
end.

А дробь, действительно, очень любопытная! В ней бесконечно повторяются
все цифры по порядку:
Паразитические числа
0.123456789012345678901234567890123456789012345678901

Клиффорд Пиковер предлагает найти и ультрапаразитов, под которыми
он подразумевает числа, которые увеличиваются в несколько раз при перемещении и первой и последней цифры. В книге нет примеров таких чисел.
Существуют ли они – неизвестно.
Если первую и последнюю цифры просто поменять местами, то они должны быть равны, но при этом исходное
число не изменится.
335

В журнале Наука и жизнь №11 за 1971 год, на странице 118 напечатана заметка:

Этот пример – почти ответ на задачу Пиковера, но в нём первая и последняя
цифры не меняются местами, а добавляются новые цифры в начало и конец
числа.
В журнале Наука и жизнь, №2 за 1972 год, на странице 142 напечатана заметка о паразитических числах:

336

Легко заметить, что в ней присутствуют числа, начинающиеся с нуля, которые мы не учитывали.

Там же сообщается:

Этот проект показывает, что иногда и паразиты могут быть полезны, если
правильно приложить их к больному месту. Правда, медицина здесь бессильна, но математика даёт пылу и жару ещё более интересным числам.

Проект Циклические числа
Исходный код программы находится в файле Циклические
числа.pas.

337

Начнём с известного примера циклических чисел (cyclic numbers). Если последовательно умножать число 142857 на числа 1..6, то мы получим такие
произведения:
// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin
var n := 142857;
foreach var i in range(1,6) do
Println($' {i} * {n} = {n * i}');
Writeln;
end;
begin
Writeln(' Циклические числа');
Writeln;
Solve;
end.

1 * 142857 = 142857
2 * 142857 = 285714
3 * 142857 = 428571
4 * 142857 = 571428
5 * 142857 = 714285
6 * 142857 = 857142
Можно заметить, что все числа состоят из одних и тех же цифр, но расположенных иначе.
Чтобы ещё более прояснить ситуацию, давайте
запишем числа по кругу. Если читать цифры по
часовой стрелке, начиная с 1, то мы получим
число 142857. Если начать с 2, то получим
число 285714. И так далее. Следовательно, все
произведения состоят из одних и тех же цифр,
записанных по кругу, то есть циклически.

338

Менее известен пример с числом 588235294117647:
var m: int64 := 588235294117647;
foreach var i in range(1,16) do
Println($' {i} * {m} = {m * i}');
Writeln;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*

588235294117647
588235294117647
588235294117647
588235294117647
588235294117647
588235294117647
588235294117647
588235294117647
588235294117647
588235294117647
588235294117647
588235294117647
588235294117647
588235294117647
588235294117647
588235294117647

=
=
=
=
=
=
=
=
=
=
=
=
=
=
=
=

0588235294117647
1176470588235294
1764705882352941
2352941176470588
2941176470588235
3529411764705882
4117647058823529
4705882352941176
5294117647058823
5882352941176470
6470588235294117
7058823529411764
7647058823529411
8235294117647058
8823529411764705
9411764705882352

Здесь 16 произведений, полученных из циклически переставляемых цифр.
Оба этих циклических числа представляют собой период бесконечных циклических дробей 1/7 и 1/17:
procedure Solve2;
begin
BigDecimal.Precision := 6;
var n1 := BigDecimal(1);
var n2 := BigDecimal(7);
var n3 := (n1 / n2);
Writeln(' ' + n3);
Writeln;
BigDecimal.Precision := 15;
339

n1 := BigDecimal(1);
n2 := BigDecimal(17);
n3 := (n1 / n2);
Writeln(' ' + n3);
Writeln;
end;

0.142857
0.0588235294117647
Длина цикла на 1 меньше знаменателя, то есть 6 в первом случае и 16 – во
втором.
Все циклические числа можно представить в форме:

Здесь:

10𝑝−1 − 1
𝑝

p – простое число
Для p = 7 имеем:
999999/7 = 142857
Для p = 17 имеем:
9999999999999999/17 = 588235294117647
Но не все простые числа порождают циклические числа. А всего около
37,395%. Из первой тысячи чисел дают циклические числа только эти простые числа:
7, 17, 19, 23, 29, 47, 59, 61, 97, 109, 113, 131, 149, 167, 179, 181, 193, 223, 229, 233,
257, 263, 269, 313, 337, 367, 379, 383, 389, 419, 433, 461, 487, 491, 499, 503, 509,
541, 571, 577, 593, 619, 647, 659, 701, 709, 727, 743, 811, 821, 823, 857, 863, 887,
937, 941, 953, 971, 977, 983.
Циклические числа обладают интересными свойствами:
340

14 + 28 + 57 = 99
142 + 857 = 999
8572 – 1422 = 714285
4117647
58823529
------------99999999
Все циклические числа, исключая 142857, начинаются с 0:
(106-1)
(1016-1)
(1018-1)
(1022-1)
(1028-1)
(1046-1)
(1058-1)
(1060-1)

/
/
/
/
/
/
/
/

7
17
19
23
29
47
59
61

=
=
=
=
=
=
=
=

142857 (6 цифр)
0588235294117647 (16 цифр)
052631578947368421 (18 цифр)
0434782608695652173913 (22 цифр)
0344827586206896551724137931 (28 цифр)
0212765957446808510638297872340425531914893617 (46 цифр)
0169491525423728813559322033898305084745762711864406779661 (58 цифр)
016393442622950819672131147540983606557377049180327868852459 (60 цифр)

Мы легко проверим, что число 142857 – циклическое, но в следующем циклическом числе – 0588235294117647 – уже 16 цифр, за перестановкой которых наблюдать интересно, но трудно.
Как показывает список выше, каждое новое циклическое число становится
всё длиннее. И для простого числа 97 соответствующее число состоит из 96
цифр:
0103092783505154639175257731958762886597938144329896907216494845360
82474226804123711340206185567
Проверять такие числа вручную крайне неостроумно, поэтому мы напишем
простую программу, которая всё сделает за нас – быстро и аккуратно:
function Test(snum: string): bool;
begin
// число:
var num := BigInteger.Parse(snum);
// длина числа:
var numlen := snum.Length;
println($' Длина цикла = {numlen}');
341

// цикл:
var cycle := snum * 2;
println($' Цикл: {cycle}');
// проверяем произведения:
foreach var i in range(2, numlen) do begin
var mult := num * i;
var smult := mult.ToString;
// не циклическое число:
if smult not in cycle then exit(False);
end;
// циклическое число:
Result := True;
end;
procedure Solve3;
begin
var snum := '142857';
snum := '0588235294117647';
snum :=
'016393442622950819672131147540983606557377049180327868852459';
snum :=
'010309278350515463917525773195876288659793814432989690721649484536082474
226804123711340206185567';
var res := Test(snum);
if (res) then
println($' Число {snum} - циклическое')
else
println(' Число {snum} - не циклическое');
end;

Так как почти все циклические числа начинаются с нуля, который паскаль
отбросит, то в тестовую функцию нужно передавать строковое представление числа. С помощью метода расширения Parse мы превратим строку в
число, которое дальше и умножим на все числа от 2 до длины заданного
числа. Например, циклическое число 142 857 мы умножим на числа 2..6.
Все произведения – это циклические перестановки исходного числа, поэтому число 142 857 – циклическое:
285714
428571
342

571428
714285
857142
Число 142 857 – циклическое
Циклические числа
Длина цикла = 6
Цикл: 142857142857
Число 142857 - циклическое
Длина цикла = 16
Цикл: 05882352941176470588235294117647
Число 0588235294117647 - циклическое
Длина цикла = 60
Цикл:
0163934426229508196721311475409836065573770491803278688524590163934426229
50819672131147540983606557377049180327868852459
Число 016393442622950819672131147540983606557377049180327868852459 циклическое

И даже огромное число
0103092783505154639175257731958762886597938144329896907216494845360
82474226804123711340206185567
наша функция проверит в один момент:
Длина цикла = 96
Цикл:
0103092783505154639175257731958762886597938144329896907216494845360824742
2680412371134020618556701030927835051546391752577319587628865979381443298
9690721649484536082474226804123711340206185567
Число
0103092783505154639175257731958762886597938144329896907216494845360824742
26804123711340206185567 - циклическое

343

Итак, в функции Test мы умножаем заданное число num на числа 2... Вопрос
в том, как проверить, что все произведения - это циклические перестановки
исходного числа.
Мы имеем строковое представление циклического числа (или кандидата в
такие числа). Если мы удвоим эту строку, то есть повторим её дважды, то
все циклические перестановки будут подстроками этой длинной строки.
Опять вернёмся к короткому числу 142857 и «удвоим» его:
142857142857
Все произведения содержатся в нём:
285714 142857142857
428571 142857142857
571428 142857142857
714285 142857142857
857142 142857142857
Действительно, если мы обходим число по кругу, то второй круг – это повторение исходного числа. Таким образом, мы можем проверить любое простое число на цикличность.
Самое большое из простых чисел до 1000 порождает вот такое циклическое
число:
0010172939979654120040691759918616480162767039674465920651068158697
8636826042726347914547304170905391658189216683621566632756866734486
2665310274669379450661241098677517802644964394710071210579857578840
2848423194303153611393692777212614445574771108850457782299084435401
8311291963377416073245167853509664292980671414038657171922685656154
6286876907426246185147507629704984740590030518819938962360122075279
7558494404883011190233977619532044760935910478128179043743641912512
7161749745676500508646998982706002034587995930824008138351983723296
0325534079348931841302136317395727365208545269582909460834181078331
6378433367243133265513733468972533062054933875890132248219735503560
5289928789420142421159715157680569684638860630722278738555442522889
1149542217700915564598168870803662258392675483214649033570701932858
344

5961342828077314343845371312309257375381485249237029501525940996948
1180061037639877924720244150559511698880976602238046795523906408952
18718209562563580874872838250254323499491353
И оно именно циклическое, в чём нас убеждает наша функция Test:
Длина цикла = 982
Цикл:
0010172939979654120040691759918616480162767039674465920651068158697863682
6042726347914547304170905391658189216683621566632756866734486266531027466
9379450661241098677517802644964394710071210579857578840284842319430315361
1393692777212614445574771108850457782299084435401831129196337741607324516
7853509664292980671414038657171922685656154628687690742624618514750762970
4984740590030518819938962360122075279755849440488301119023397761953204476
0935910478128179043743641912512716174974567650050864699898270600203458799
5930824008138351983723296032553407934893184130213631739572736520854526958
2909460834181078331637843336724313326551373346897253306205493387589013224
8219735503560528992878942014242115971515768056968463886063072227873855544
2522889114954221770091556459816887080366225839267548321464903357070193285
8596134282807731434384537131230925737538148524923702950152594099694811800
6103763987792472024415055951169888097660223804679552390640895218718209562
5635808748728382502543234994913530010172939979654120040691759918616480162
7670396744659206510681586978636826042726347914547304170905391658189216683
6215666327568667344862665310274669379450661241098677517802644964394710071
2105798575788402848423194303153611393692777212614445574771108850457782299
0844354018311291963377416073245167853509664292980671414038657171922685656
1546286876907426246185147507629704984740590030518819938962360122075279755
8494404883011190233977619532044760935910478128179043743641912512716174974
5676500508646998982706002034587995930824008138351983723296032553407934893
1841302136317395727365208545269582909460834181078331637843336724313326551
3733468972533062054933875890132248219735503560528992878942014242115971515
7680569684638860630722278738555442522889114954221770091556459816887080366
2258392675483214649033570701932858596134282807731434384537131230925737538
1485249237029501525940996948118006103763987792472024415055951169888097660
223804679552390640895218718209562563580874872838250254323499491353
Число
0010172939979654120040691759918616480162767039674465920651068158697863682
6042726347914547304170905391658189216683621566632756866734486266531027466
9379450661241098677517802644964394710071210579857578840284842319430315361
1393692777212614445574771108850457782299084435401831129196337741607324516
7853509664292980671414038657171922685656154628687690742624618514750762970
4984740590030518819938962360122075279755849440488301119023397761953204476
345

0935910478128179043743641912512716174974567650050864699898270600203458799
5930824008138351983723296032553407934893184130213631739572736520854526958
2909460834181078331637843336724313326551373346897253306205493387589013224
8219735503560528992878942014242115971515768056968463886063072227873855544
2522889114954221770091556459816887080366225839267548321464903357070193285
8596134282807731434384537131230925737538148524923702950152594099694811800
6103763987792472024415055951169888097660223804679552390640895218718209562
563580874872838250254323499491353 - циклическое

7, 17, 19, 23, 29, 47, 59, 61, 97, 109, 113, 131, 149, 167, 179, 181, 193, 223, 229, 233,
257, 263, 269, 313, 337, 367, 379, 383, 389, 419, 433, 461, 487, 491, 499, 503, 509,
541, 571, 577, 593, 619, 647, 659, 701, 709, 727, 743, 811, 821, 823, 857, 863, 887,
937, 941, 953, 971, 977, 983.
Если мы возьмём другие простые числа (не вошедшие в список выше), то
убедимся, что период дроби 1/p короче, чем у простых чисел, порождающих
числа циклические:
11 – 0.09… (должно быть 10)
13 – 0.076923 (должно быть 12)
Опять же – проверять вручную долго и утомительно, поэтому мы напишем
небольшую программу, которая самостоятельно проверит все простые
числа в заданном диапазоне:
uses MathExtensions;
// РЕШАЕМ ЗАДАЧУ
procedure Solve;
begin
foreach var p in GeneratePrimes do begin
if p = 2 then continue;
// алгоритм деления в столбик для нахождения периода:
var remainder := 1;
var digits := new List<char>;
var remainders := new Dictionary<int, int>;
var position := 0;
var periodFound := false;
var periodStart := 0;
while not periodFound and (position < 2000) do begin
if remainders.ContainsKey(remainder) then begin
346

periodFound := true;
periodStart := remainders[remainder];
end
else begin
remainders[remainder] := position;
remainder := remainder * 10;
digits.Add(char(ord('0') + remainder div p));
remainder := remainder mod p;
position := position + 1;
end;
end;
if periodFound then begin
var periodLength := digits.Count - periodStart;
if periodLength = p - 1 then begin
Write(' 1/', p:2);
Writeln(' ✓ Циклическое простое!');
end;
end;
if p > 1100 then break;
end;
Writeln;
end;

begin
Writeln(' Циклические числа 2');
Writeln;
Solve;
end.

Она назовёт нам следующие простые числа, порождающие циклические:
Циклические числа 2
1/ 7
1/17
1/19
1/23
1/29
1/47

✓
✓
✓
✓
✓
✓

Циклическое
Циклическое
Циклическое
Циклическое
Циклическое
Циклическое

простое!
простое!
простое!
простое!
простое!
простое!

1/503
1/509
1/541
1/571
1/577
1/593

✓
✓
✓
✓
✓
✓

Циклическое
Циклическое
Циклическое
Циклическое
Циклическое
Циклическое

простое!
простое!
простое!
простое!
простое!
простое!
347

1/59 ✓ Циклическое простое!
1/61 ✓ Циклическое простое!
1/97 ✓ Циклическое простое!
1/109 ✓ Циклическое простое!
1/113 ✓ Циклическое простое!
1/131 ✓ Циклическое простое!
1/149 ✓ Циклическое простое!
1/167 ✓ Циклическое простое!
1/179 ✓ Циклическое простое!
1/181 ✓ Циклическое простое!
1/193 ✓ Циклическое простое!
1/223 ✓ Циклическое простое!
1/229 ✓ Циклическое простое!
1/233 ✓ Циклическое простое!
1/257 ✓ Циклическое простое!
1/263 ✓ Циклическое простое!
1/269 ✓ Циклическое простое!
1/313 ✓ Циклическое простое!
1/337 ✓ Циклическое простое!
1/367 ✓ Циклическое простое!
1/379 ✓ Циклическое простое!
1/383 ✓ Циклическое простое!
1/389 ✓ Циклическое простое!
1/419 ✓ Циклическое простое!
1/433 ✓ Циклическое простое!
1/461 ✓ Циклическое простое!
1/487 ✓ Циклическое простое!
1/491 ✓ Циклическое простое!
1/499 ✓ Циклическое простое!

1/619
1/647
1/659
1/701
1/709
1/727
1/743
1/811
1/821
1/823
1/857
1/863
1/887
1/937
1/941
1/953
1/971
1/977
1/983
1/1019
1/1021
1/1033
1/1051
1/1063
1/1069
1/1087
1/1091
1/1097
1/1103

✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!
✓ Циклическое простое!

Если вы хотите продолжить поиски, то увеличьте точность дробей.
В журнале Наука и жизнь, №2 за 1968 год, на странице 57 напечатана такая
задача:

348

Ответ на неё – знаменитое число 142 857:

Эта задача связывает паразитические числа с циклическими, так как при
переносе конечной семёрки число увеличивается в 5 раз.

Проект Супержесть
Исходный код программы находится в файле Супержесть.pas.

Эта задача пришла к нам окольным путём из Интернета в виде ютубовского ролика Супержесть для тех, кому скучно. Если кому реально скучно,
то посмотрите на предварительные мозговые мучения, возникшие во
время решения этой задачи рукоголовым способом, чтобы оценить толщину предстоящей нам жести. Даю адресочек:
https://www.youtube.com/watch?v=_6OfnRKtadc

349

Нас, конечно, никакой жестью не запугаешь, но поработать и руками, и
слегка головой тоже – придётся. Но это несравнимо с решением задачи голыми руками.
Замечаем, что нам понадобятся факториалы чисел от четырёх до пятидесяти. В большом деле лучше не мельчить, а сразу вычислить все факториалы и упаковать их в список, из которого всё что угодно извлекать просто
и удобно. Поскольку факториалы стремительно увеличиваются, то они
должны иметь тип BigInteger.
Метод расширения FactorialSequence из модуля BigIntegerExtensions выдаёт последовательность факториалов в заданном количестве:
/// ВЫДАЁТ ПОСЛЕДОВАТЕЛЬНОСТЬ ФАКТОРИАЛОВ
function FactorialSequence(n: integer): sequence of BigInteger;
begin
if n < 0 then
raise new System.ArgumentOutOfRangeException('Число не может быть
отрицательным!');
var fact := BigInteger(1);
yield fact;
for var i := 1 to n do begin
fact := fact * i;
yield fact;
end;
end;

Перед приступом к решению задачи мы получаем в переменной facts список
всех нужных нам факториалов.
uses BigIntegerExtensions;
// РЕШАЕМ ЗАДАЧУ
procedure Solve();
begin
// список факториалов от 0 до 50 включительно:
var facts := 50.FactorialSequence.ToList;
350

В качестве обязательной проверки распечатываем все факториалы на
экране.
foreach var bi in facts do
println(bi);
. . .
begin
Writeln(' Супержесть');
Writeln;
Solve();
end.

В задачном выражении очевидно проглядывает сумма членов ряда, которую выгодно и полезно вычислять в цикле. Переменная цикла, как следует
из задания, изменяется от четырёх до пятидесяти включительно:
// решаем задачу:
var summa := BigInteger.Zero;
for var i := 4 to 50 do begin

Значения членов ряда вычисляются так: переменную цикла умножаем на
неё же, но с добавкой двойки. Это произведение умножаем на квадрат факториала, который извлекаем из списка согласно текущему значению переменной цикла.
var f := facts[i];

Все произведения добавляем к переменной summa, которая изначально
равна нулю:
summa += i * (i + 2) * f * f;
end;
351

Из любопытства и для проверки бдительности смотрим на экране, чего мы
там насуммировали:
Writeln($' Значение выражения = {summa}');

Нас интересуют только 24 последние цифры этого здоровенного числа.
Проще и удобнее отрезать такого размера правоконечный кусок числа из
строки:
// последние 24 цифры:
var str24 := summa.ToString();
str24 := str24.Substring(str24.Length - 24);

Осталось найти сумму двухдюжинной цифири и финишировать с рекордным результатом!
var bi24 := BigInteger.Parse(str24);
println(bi24);

Исключительно для этого и для поддержания спортивной формы мы находим сумму цифр в методе расширения DigitSumBig.
// сумма этих цифр -> ответ на задачу:
var sum := bi24.DigitSumBig;
println(sum);
Writeln;
end;

Тут мы ставим жирную точку, а поверх - печать ответа на экране. И олимпиадной сказочке пришёл конец.
Супержесть
1
352

1
2
6
24
120
720
5040
40320
362880
3628800
39916800
479001600
6227020800
87178291200
1307674368000
20922789888000
355687428096000
6402373705728000
121645100408832000
2432902008176640000
51090942171709440000
1124000727777607680000
25852016738884976640000
620448401733239439360000
15511210043330985984000000
403291461126605635584000000
10888869450418352160768000000
304888344611713860501504000000
8841761993739701954543616000000
265252859812191058636308480000000
8222838654177922817725562880000000
263130836933693530167218012160000000
8683317618811886495518194401280000000
295232799039604140847618609643520000000
10333147966386144929666651337523200000000
371993326789901217467999448150835200000000
13763753091226345046315979581580902400000000
523022617466601111760007224100074291200000000
20397882081197443358640281739902897356800000000
815915283247897734345611269596115894272000000000
33452526613163807108170062053440751665152000000000
1405006117752879898543142606244511569936384000000000
60415263063373835637355132068513997507264512000000000
2658271574788448768043625811014615890319638528000000000
119622220865480194561963161495657715064383733760000000000
353

5502622159812088949850305428800254892961651752960000000000
258623241511168180642964355153611979969197632389120000000000
12413915592536072670862289047373375038521486354677760000000000
608281864034267560872252163321295376887552831379210240000000000
30414093201713378043612608166064768844377641568960512000000000000
Значение выражения =
2405969386799803097354037351136533457791015186104367070023668243919926294
435854489984638737378305808000876543999999999999999999999424
999999999999999999999424
199

354

Литература
[ОО80]
Оре О.
Приглашение в теорию чисел

М.: Наука, 1980 г. - 128 с.
Библиотечка Квант, Выпуск 3

[ЗП88]
Абрамов С.А. и др.
Задачи по программированию

Наука, 1988. – 224 с.
ISBN: 5-02-013774-Х
Серия: Библиотечка программиста
355

[100]
В. А. Дагене, Г. К. Григас, К. Ф. Аугутис
100 задач по программированию

М.:Просвещение, 1993. – 251 с.
ISBN: 5-09-003864-3

[ВНН88]
Воробьёв Н.Н.

Признаки делимости

Наука. - 1988, 96 с.
ISBN 5-02-013731-6

356

[БК85]
Брудно А. Л. Каплан Л. И.

Олимпиады по программированию для
школьников

Наука. - 1985, 96 с.

[ГМ72]
Гарднер Мартин

Математические досуги

М.: Мир, 1972. – 495 с.

357