Классическая постановка задачи о «восьми ферзях» весьма проста: надо расположить на шахматной доске восемь ферзей так, чтобы ни один из них не мог одним ходом побить другого.
Иными словами, никакие два ферзя не должны находиться на одной горизонтали, вертикали или диагонали — именно так ведь ходит ферзь.
Несмотря на простоту постановки, в решении задачи есть некоторые сложности. Аналитический способ её решения, увы, неизвестен, поэтому остаётся, фактически, только решение перебором.
Но и с перебором тоже не всё так очевидно. Особенно если обобщить задачу до «найти все способы размещения любого количества ферзей на доске» — ну, так, чтобы размещения одного ферзя, двух ферзей и даже ста ферзей, если такое каким-то чудом получится, тоже вошло бы в ответ.
Казалось бы, а чего тут такого? 1 — есть на этом поле ферзь, 0 — нет ферзя. Переберём все варианты, для каждого проверим, не бьют ли какие-то ферзи друг друга…
Но, увы, в максимально тупом подходе таких вариантов будет
Это слишком до фига, мягко говоря.
При этом тут уже учтено, что ферзи — совершенно одинаковые и взаимозаменяемые: если бы мы вдобавок по недосмотру предположили их разными, то и без того огромное количество вариантов стало бы ещё больше.
В общем, такой полный перебор «в лоб» тут явно не подходит. Надо искать какие-то более умные способы.
Например, если ограничить количество ферзей ровно восемью и перебирать только такие варианты, то вариантов будет уже поменьше:
Это тоже, блин, немало, но хотя бы уже возможно к перебору за разумный срок.
Следующий вопрос: как это перебирать. Ясень пень, что на компьютере, но как должна выглядеть программа?
Вот тут у нас появляется шанс ещё раз восхититься современными подходами к программированию, а заодно и к мышлению.
Прежние «классические» реализации включали в себя вложенные циклы. Более продвинутые — рекурсивный вызов функции, но, по сути, это тоже оказывалось просто более удобным способом вызова циклов (однако так хотя бы не приходится писать восемь циклов, вложенных друг в друга).
Но это всё равно получается длинно и запутанно.
В результате, это тяжело понимать, поскольку оно написано на «нечеловеческом языке». На «нечеловеческом» в том смысле, что человеку тяжело мыслить в терминах «счётчиков циклов». Да, можно напрячься и разобрать, что там происходит, однако, подозреваю, сам её автор — Вирт — через год уже читал бы эту программу так, будто бы впервые её видит.
Сейчас же уже есть альтернатива: давайте взглянем на эту задачу так, будто бы циклы для неё нам вообще не нужны — исключительно через множества.
У нас есть множество полей доски, имеющих координаты. Ну, прямо как в шахматах, только вместо буквы и цифры мы для их адресации будем использовать пару цифр:
Например, {2, 3} — это вторая слева клетка по горизонтали и третья сверху по вертикали.
Этим множеством будет, например, просто список таких пар координат.
field[wx_, wy_] := Flatten[Table[{x, y}, {y, wy}, {x, wx}], 1]
{ {1, 1}, {2, 1}, {3, 1}, {1, 2}, {2, 2}, {3, 2}, {1, 3}, {2, 3}, {3, 3} }
Как нам перебрать все возможные позиции одной фигуры?
Элементарно: возьмём первую попавшуюся клетку из этого множества и запомним её. Теперь, если эту клетку из изначального множества убрать, то в нём снова останутся только те позиции, которые мы не перебрали.
Дальше мы можем повторить тот же процесс, пока на некотором шаге у нас не останется пустое множество возможных позиций.
Что это нам даёт? Не проще ли было бы циклами?
Пока да, если и не проще, то хотя бы сравнимо.
Точнее, пока что нам вообще не надо было что-то делать, ни циклами, ни чем-либо другим: исходное множество позиций на доске — это уже и так множество всех возможных позиций одной фигуры.
Но положение поменяется, когда мы начнём перебирать позиции двух фигур. Ведь после того, как мы убрали первую клетку из множества возможных позиций, в этом множестве остались не только возможные позиции этой первой фигуры, но и второй фигуры тоже.
Теперь мы можем вызывать точно ту же функцию для второй фигуры, передав в неё текущий вариант множества возможных позиций.
Поясню на примере с доской поменьше — 2×2.
Наше изначальное множество вот такое:
{1, 1}, {2, 1},
{1, 2}, {2, 2}
Мы убрали из него первую клетку и осталось
{2, 1},
{1, 2}, {2, 2}
Это — те позиции, которые следует перебрать для второй фигуры, когда первая стоит на первой клетке.
После этого мы можем взять вторую клетку, и снова убрать её из множества возможных позиций.
{1, 2}, {2, 2}
Это — те позиции, которые надо перебрать для второй фигуры, когда первая стоит на второй клетке.
Почему тут отсутствует позиция {1, 1}? Потому что фигуры у нас идентичные и все позиции для фигуры в клетке {1, 1} мы уже перебрали, когда в ней стояла первая фигура.
И тут по-прежнему всё ещё можно было бы «циклами» — ну да, подшаманили бы со счётчиками, всё такое. Однако для шаманства уже пришлось бы чуть-чуть поднапрячь интеллект. А с множествами всё предельно прямолинейно — никаких условий (кроме проверки на пустоту списка), никаких циклов (хотя рекурсивные вызовы, вообще говоря, аналог цикла) и, самое главное, никаких хитрых манипуляций со счётчиками: эти манипуляции проделываются сами собой — при удалении одного за другим перебираемых элементов.
Но совсем круто станет, когда дело дойдёт до проверки того, бьёт ли ферзь другого ферзя.
Дело в том, что при данном подходе мы этого вообще можем не проверять. Нам достаточно лишь удалить из множества возможных позиций те, которые покрывает ферзь, стоящий на той клетке, которую мы сейчас проверяем.
Если убрать все эти позиции из множества возможных позиций, то оставшиеся будут ровно теми, которые не бьёт ни один ферзь.
Тут для примера уже нужно поле побольше. Пусть, например, четыре.
{1, 1}, {2, 1}, {3, 1}, {4, 1},
{1, 2}, {2, 2}, {3, 2}, {4, 2},
{1, 3}, {2, 3}, {3, 3}, {4, 3},
{1, 4}, {2, 4}, {3, 4}, {4, 4}
Посмотрим на ферзя на первой позиции. Он должен убрать из расчёта первую горизонталь, первую вертикаль и соответствующую диагональ.
{1, 1}, {2, 1}, {3, 1}, {4, 1},{1, 2}, {2, 2},{3, 2}, {4, 2},{1, 3},{2, 3},{3, 3},{4, 3},{1, 4},{2, 4}, {3, 4},{4, 4}
Незачёркнутое — это множество тех позиций, которые возможны для второй фигуры. Именно их и надо для неё перебрать — ровно тем же способом.
Причём, мы начнём эту проверку сразу с клетки {3, 2}, поскольку теперь уже она — первая попавшаяся. И сразу же снова устраним из множества те клетки, которые бьёт второй ферзь (при этом, заметьте, те клетки, которые были отсеяны на первом ферзе, нарисованные тут серым — уже отсеяны, их мы повторно не проверяем).
{1, 1}, {2, 1}, {3, 1}, {4, 1},{1, 2}, {2, 2}, {3, 2}, {4, 2},{1, 3}, {2, 3}, {3, 3}, {4, 3},{1, 4},{2, 4},{3, 4}, {4, 4}
Третьему ферзю теперь передаётся множество возможных позиций, в котором только одна клетка.
Та-дам. Одно решение найдено: {1, 1}, {3, 2}, {2, 4}
Следующей клеткой для второго ферзя будет {4, 2}. А потом, когда мы переберём все его позиции в отфильтрованном множестве, дойдёт дело и до перемещения первого ферзя в следующую первую попавшуюся клетку.
Ну и так далее.
Вместо проверок условий внутри циклов у нас теперь фильтровка множеств и извлечение из них первых попавшихся элементов.
Функция же, используемая в качестве критерия фильтрации, весьма простая.
test[{x0_, y0_}][{x_, y_}] := ! (
x0 == x ||
y0 == y ||
(x — y == x0 — y0) ||
(x + y == x0 + y0)
)
В ней буквально написано то самое: «не находятся на одной горизонтали, вертикали или диагонали».
Отфильтровать множество тоже очень просто. Скажем, для точки {1, 2} это будет выглядеть вот так:
Select[test[{1, 2}], myFields]
К данному моменту вся программа уже описана практически целиком. Не рассмотрен только сам процесс формирования результата.
И тут мы снова мыслим исключительно множествами.
Предположим, у нас уже есть функция, которая возвращает список с перечнями позиций следующих фигур (список списков, иными словами — в каждом списке второго уровня хранятся пары координат, на которых стоят фигуры).
К каждому такому списку надо прицепить спереди, рассматриваемую в данный момент позицию.
Однако вернувшийся к нам список, вполне возможно, не содержит позиций вообще. И это только возможно, а не гарантировано. Поэтому нам надо проигнорировать (то есть просто удалить) все вхождения пустого перечня позиций из результатов, а потом отдельно добавить перечень, в котором есть только текущая позиция: это нам гарантирует, что такой элемент в список включён ровно один раз.
Ну а затем нам надо снова вызвать ту же функцию, в которой мы сейчас находимся, но передать в неё уже список известных нам перечней позиций, а также список возможных позиций, из которого исключена текущая.
Вот как будет выглядеть этот код.
field[wx_, wy_] := Flatten[Table[{x, y}, {y, wy}, {x, wx}], 1]
test[{x0_, y0_}][{x_, y_}] := ! (x0 == x || y0 == y ||
(x — y == x0 — y0) || (x + y == x0 + y0))
proceed[result_, cells_, testF_] := Block[
{
first = First@cells,
rest = Rest@cells,
next, nextCells, newResult
},
nextCells = Select[rest, testF@first];
next = proceed[{}, nextCells, testF];
next = DeleteCases[next, {}];
newResult = Prepend[#, first] & /@ next;
newResult = Prepend[newResult, {first}];
proceed[result ~Join~ newResult, rest, testF]
]
proceed[result_, {}, testF_] := result
Ну или, если с расшифровкой.
field[wx_, wy_] := Flatten[Table[{x, y}, {y, wy}, {x, wx}], 1]
(* генерация начального списка позиций *)
test[{x0_, y0_}][{x_, y_}] := ! (
x0 == x || y0 == y ||
(x — y == x0 — y0) || (x + y == x0 + y0)
)
(* критерий проверки, что ферзь, стоящий в {x0, y0}, не бьёт клетку {x, y} *)
proceed[result_, cells_, testF_] := Block[
{
first = First@cells, (*первая попавшаяся клетка*)
rest = Rest@cells, (*остальные клетки*)
next, nextCells, newResult (*переменные, введённые для удобства*)
},
nextCells = Select[rest, testF@first];
(*убрать из множества клетки, которые бьёт фигура, стоящая на клетке first*)
next = proceed[{}, nextCells, testF];
(*найти все позиции, для следующих фигур*)
next = DeleteCases[next, {}];
(*возможны варианты, когда подходящих позиций нет, надо исключить пустые списки*)
newResult = Prepend[#, first] & /@ next;
(* добавить к найденным позициям следующих фигур рассматриваемую сейчас позицию фигуры — first *)
ewResult = Prepend[newResult, {first}];
(* добавить позицию фигуры, стоящей в first при отсутствии других фигур *)
proceed[result~Join~newResult, rest, testF]
(* добавить новые найденные позиции к найденным ранее и продолжить процесс для следующей позиции*)
]
proceed[result_, {}, testF_] := result
(* тот самый случай, когда список возможных позиций пуст *)
Короткая и понятная программа. Короткая, несмотря даже на то, что я некоторые операции разбил на несколько строк, чтобы было проще написать пояснение для того, что происходит в каждой из строк.
Теперь, собственно, осталось написать функцию, упрощающую запуск процесса.
queens[{wx_, wy_}] := proceed[{}, field[wx, wy], test]
Заметьте, в отличие от варианта Вирта, в этом коротком и лаконичном варианте реализовано решение задачи в общем виде — для любого размера поля, находящее все возможные варианты расстановки фигур, а не только ровно восьми.
Впрочем, для восьми или любого другого точного количества получить ответ очень просто: достаточно выбрать при помощи Select только те результаты, где содержится ровно восемь позиций.
Select[results, Length@# == 8 &]
Вдобавок данная реализация подходит для любых фигур, а не только для ферзей — надо только лишь при запуске процесса передать в него другую функцию фильтрации полей.
На этом месте многие заподозрят подвох. Типа, не может быть так, что более короткая реализация одновременно с тем более универсальна. Наверняка должен быть какой-то подводный камень, который потопчет нам всю малину.
Быть может, такая реализация работает медленнее, чем реализация с циклами?
Или даже гораздо медленнее?
Парадокс в том, что эта реализация, внезапно, быстрее, чем большинство простых «классических».
Дело в том, что здесь перебор вариантов делается с чрезвычайно быстрым их отсевом. В классическом варианте для следующей фигуры в лучшем случае исключается только горизонталь и вертикаль текущей фигуры, здесь же горизонталь, вертикаль и обе диагонали текущей фигуры исключаются для всех последующих фигур сразу. Таким образом, количество перебираемых вариантов стремительно сокращается с глубиной вложенности.
Как уже говорилось ранее, полное количество вариантов для восьми ферзей на доске 8×8 — 4 426 165 368. Если же сразу отбрасывать горизонталь и вертикаль, то их будет 16 777 216.
Однако данный алгоритм для ферзей на доске 8×8 не просто переберёт, а даже вообще зайдёт в функцию proceed всего 118 968 раз.
Именно что зайдёт — ведь в «классических» решениях каждая из комбинаций ещё и проверяется на то, что в ней ни один ферзь не бьёт другого, а здесь такие проверки делаются гораздо меньшее число раз: фильтрация клеток, которые бьёт первый ферзь, стоящий на первой клетке — для 63 клеток, вложенные для второго ферзя — уже для 42, и так далее. В классическом же варианте каждая итерация требует 7*8=56 проверок.
Да, классический вариант можно ускорить, например, учтя, что найденную комбинацию тут же можно преобразовать в другую — поворотом на угол, кратный 90° и/или зеркальным отражением.
Но штука в том, что и этот тоже можно так же. Если его адаптировать до частного случая с точным числом фигур, то можно учесть не только повороты с отражениями, но ещё и прерывать поиск «в глубину» в те моменты, когда во множестве доступных позиций их меньше, чем требуется разместить фигур.
Учёт поворотов и отражений даст уже 14 871 заходов, на каждом из которых делаются вот эти, более простые проверки. И ещё сколько-то заходов нам сэкономит отбрасывание заведомо провальных случаев.
Тогда как самые ловкие манипуляции, с отбрасыванием вертикалей и горизонталей (что, как легко догадаться, является захардкоживанием ферзей и ладей) позволяют сократить количество проверок лишь до 40 320 заходов по 56 проверок двух диагоналей в каждом.
Быть может, тогда использование этих ваших списков затормозит процесс? Ведь там, судя по всему, на каждой итерации постоянно генерируются какие-то списки — в диких количествах.
И тут тоже всё несколько не так, как поначалу кажется. Текущая позиция не зря добавляется в начало списка позиций следующих фигур, а не в его конец.
Дело в том, что в данном случае используются так называемые «связные списки». В которых хранение элементов реализовано тем, что каждый предыдущий элемент хранит ссылку на следующий. Когда в такой список спереди добавляется ещё один элемент, то при этом всего лишь заводится ещё один элемент, в который заносится ссылка на первый элемент уже существующего списка.
Таким образом все списки и все их части создаются ровно по одному разу на каждый элемент, а копирования уже имеющихся элементов не происходит вообще.
В результате, более-менее затратной оказывается только фильтрация списков, однако её мы компенсируем радикальным сокращением количества перебираемого.
Поэтому, таки да, решение через множества оказывается и более коротким, и более универсальным, и более быстрым.
Чудо? Нет. Современный подход, позволяющий осмыслять задачи в иных терминах, нежели раньше.
Впрочем, можно сделать подход ещё более современным, если обратить внимание на то, что используемая в данном решении рекурсия, скорее всего, подходит не только для данной задачи.
А раз так, то имеет смысл реализовать подобную обработку списка в более общем виде и уже в рамках этой реализации сформулировать решение данной задачи, как частный случай более общего.
Внутри функции proceed сейчас перебираются все ячейки по очереди, однако используется не только текущая ячейка, но и все, идущие после неё, — именно они потом используются для перебора позиций следующих ферзей.
Поэтому для начала можно превратить список ячеек в список пар. То есть список
должен стать списком
Поскольку подходящей готовой функции в Mathematica нет, для её реализации можно воспользоваться функцией «свёртки» — FoldList.
FoldList получает три параметра — некоторую функцию f, начальное значение и список элементов. После чего последовательно применяет f к паре, состоящей из предыдущего результата применения функции и текущего элемента списка.
Так, например,
даст в результате
f(0, a)
f(f(0, a), b)
f(f(f(0, a), b), c)
Начав с {0, list}, мы на каждом шаге будем создавать пару из текущего элемента и всех элементов, кроме первого, из того списка, который нам передаётся в виде предыдущего значения.
А потом для каждого его элемента можно будет вызвать некоторую функцию.
movingSplit[list_] := Rest@FoldList[{#2, Rest@Last@#1} &, {0, list}, list]
splitFold[f_][list_] := f @@ # & /@ movingSplit@list
Тут, соответственно, movingSplit совершает вышеуказанное разбиение, а splitFold использует его для того, чтобы вызывать некоторую, переданную в виде параметра функцию f для каждого элемента этого нового списка.
В этих терминах решение переформулируется ещё более коротким образом:
distribute[x_, list_] := {{x}} ~Join~ (Prepend[x] /@ list)
(* Преобразовать {a, {b, c, d}} в {{a}, {a, b}, {a, c}, {a, d}} *)
proceed[testF_][first_, rest_] := distribute[first, proceed[testF]@Select[rest, testF@first]]
(* Ферзь стоит на first, надо убрать из rest все ячейки, которые он бьёт, и попробовать поставить на них других ферзей *)
proceed[testF_][cells_] := Flatten[splitFold[proceed@testF]@cells, 1]
(* Вышеописанное надо проделать для всех ячеек cells *)
Учитывая, что функция splitFold — универсальная и потому может применяться не только к данной задаче, решение фактически состоит из этих трёх строк, а также из функции начальной генерации ячеек и функции, при помощи которой выбираются ячейки, которые не бьёт некоторый ферзь.
field[wx_, wy_] := Flatten[Table[{x, y}, {y, wy}, {x, wx}], 1]
(* генерация начального списка позиций *)
test[{x0_, y0_}][{x_, y_}] := ! (
x0 == x || y0 == y ||
(x — y == x0 — y0) || (x + y == x0 + y0)
)
(* критерий проверки, что ферзь, стоящий в {x0, y0}, не бьёт клетку {x, y} *)
Надо отметить, что этот вариант на чудо похож уже гораздо больше, и даже я сам, написав этот вариант, уже не совсем верю, что решение данной задачи может быть столь лаконичным.
Тем не менее, да, вот этого вот оказалось вполне достаточно, причём заодно ещё для каких-то других задач была сделана полезная тулза.
И да, ровно так же это решение можно реализовать на множестве других современных языков, поддерживающих ссылки на функции и создание функций «на лету» — Scala, Java, Python, Kotlin, C# и даже C++.
Даже странно, что далеко не все программисты этим пользуются.