Перечислить все расстановки 8-ми ферзей на шахматной доске, при которых они не бьют друг друга

Материал из DRKB


Классической задачей, которая решается методом перебора с отходом назад считается задача о восьми ферзях: требуется перечислить все способы расстановки 8-ми ферзей на шахматной доске 8 на 8, при которых они не бьют друг друга. Эту задачу решил больше 200 лет тому назад великий математик Леонард Эйлер. Заметьте, что у него не было компьютера, но тем не менее он абсолютно верно нашел все 92 таких расстановки!

Очевидно, на каждой из 8 вертикалей должно стоять по ферзю. Каждую такую расстановку можно закодировать одномерным массивом X[1], ..., X[8], где X[i] - номер горизонтали для i-го ферзя. Поскольку никакие два ферзя не могут стоять на одной горизонтали (тогда они бьют друг друга), то все X[i] различны, т.е. образуют перестановку из чисел 1..8. Можно, конечно, перебрать все 8! таких перестановок и выбрать среди них те 92, которые нас интересуют. Hо число 8! = 40320 довольно большое.

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

program Queens;

const
  N = 8;

type
  TIndex = 1..N;
  TRasstanovka = array [TIndex] of 0..N;

var
  X: TRasstanovka;
  Count: Word;

function P(var X: TRasstanovka; k, y: TIndex): Boolean;
var
  i: TIndex;
begin
  i := 1;
  while (i < k) and (y <> X[i]) and (abs(k-i) <> abs(y-X[i])) do
    Inc(i);
  Result := (i = k);
end;

procedure Backtracking(k: TIndex);
var
  i, y: TIndex;
begin
  for y := 1 to N do
    if P(X, k, y) then
    begin
      X[k] := y;
      if k = N then
      begin
        for i := 1 to N do
          Write(X[i]);
        WriteLn;
        Inc(Count);
      end;
      Backtracking(k+1);
    end
end;

begin
  Count := 0;
  WriteLn('Расстановки ', N, ' ферзей:');
  Backtracking(1);
  WriteLn('Всего ', Count, ' расстановок');
end.


Source: http://algolist.manual.ru
ID: 04180