Модуль перебора с возвратом (pdaBackTrack.pas) является расширением основного модуля библиотеки (pdaMIRObject.pas).
Парадигма библиотеки MIR подразумевает три основных класса.
TpdaBacktrackEnvironment = class(TpdaMIREnvironment) - окружающая среда, окружение. Наследуется от класса, расположенном в pdaMIRObject.
TpdaBackTrackSolution = class - решение. В решении кодируется задача.
TpdaMIREnvironmentController - класс-контроллер. Он определен в pdaMIRObject и наследуется в проекте Вашего приложения.
TpdaBacktrackEnvironment реализует алгоритм перебора с возвратом.
В нем организован цикл, который собственно переходит по шагам, альтернативам, вызывает возврат.
Окружающая среда
В общем смысле, большое множество алгоритмов использует один механизм - многократные итерации.
В классе TpdaMIREnvironment определено поле
FTotalIteration: TCountIteration;
которое на каждой итерации увеличивается на единицу. Поле
FTotalIteration: TCountIteration;
задаваемое до прогона, ограничивает общее количество итераций.
Контроллер
В приложении обычно на главной форме присутствуют элементы управления, такие как панели или поля, в которых производится индикация процесса прогона: текущая итерация, количество найденных решений, печатаются сами решения.
Программист-пользователь библиотеки конструирует интерфейс по своему собственному усмотрению. Чтобы не зашивать в код алгоритма куски кода, которые, например помещают в панель значение текущей итерации, существует контроллер.
Базовый класс контроллера TpdaMIREnvironmentController определен в головном модуле библиотеки (pdaMIRObject.pas) и не переопределяется для различных алгоритмов: для генетического алгоритма, алгоритма искусственной жизни и алгоритма перебора с возвратом используется один базовый класс TpdaMIREnvironmentController .
Базовый класс Контроллера TpdaMIREnvironmentController имеет набор методов, которые программист может переопределить (override). В этих методах можно выбрать информацию о состоянии процесса прогона и вывести ее на элементы управления. Архитектура отличается от обычных эвентов Delphi и выполнена в классическом ООП-стиле.
TpdaMIREnvironmentController = class(TObject)
private
procedure AttachGamingWorld(AGamingWorld: TpdaMIREnvironment);
protected
FEnvironment: TpdaMIREnvironment;
public
constructor Create();virtual;
destructor Destroy;override;
property Environment: TpdaMIREnvironment read FEnvironment write AttachGamingWorld;
procedure DeAttachGamingWorld;
public
procedure ObjectsGeneratedNotify;virtual;
procedure ObjectsDestroyedNotify;virtual;
procedure BeginSimulationNotify;virtual;
procedure EndSimulationNotify;virtual;
procedure BeginAgeNotify;virtual;
procedure EndAgeNotify;virtual;
procedure BeginIterationNotify;virtual;
procedure EndIterationNotify;virtual;
procedure EnvironmentDestroyNotify;virtual;
procedure SolutionDoneFindedNotiry;virtual;
public
end;
Эти методы вызываются в следующие моменты прогона
procedure ObjectsGeneratedNotify;virtual; - объекты были созданы
procedure ObjectsDestroyedNotify;virtual; -объекты были уничтожены
procedure BeginSimulationNotify;virtual; - перед самым началом прогона
procedure EndSimulationNotify;virtual; - после окончания прогона
procedure BeginAgeNotify;virtual; -началась новая эпоха (эпохи используются в алгоритме отжига. Там в конце каждой эпохи производится уменьшение температуры).
procedure EndAgeNotify;virtual; - закочилась эпоха
procedure BeginIterationNotify;virtual; - перед итерацией
procedure EndIterationNotify;virtual; - после итерации
procedure EnvironmentDestroyNotify;virtual; - уничтожение окружения
procedure SolutionDoneFindedNotiry;virtual; - найдено решение
Программист должен в отдельном модуле подключить в uses форму, в которой описать обработку этих событий и отрисовку информации на форме.
Пример
Примером является задача расстановки ферзей на квадратном клетчатом поле таки образом, чтобы они не били друг друга.
Создание проекта
Создадим новый проект, добавим главную форму. На главной форме располагаем следующие элементы управления:
pCurentIteraion: Tpanel; //вывод номера текущей итерации
cResultTotalIteration: TDBNumberEditEh; // Количество выполненных итераций (я пользуюсь библиотекой Ehlib, можно воспользоваться Tedit)
cBtResultCountSolutions: TDBNumberEditEh; // Количество найденных решений
cLog: TMemo; // Для вывода сообщений о выполнении процесса и распечатки найденных решений
cTotalIterations: TDBNumberEditEh; // предельное количество итераций
//используется для предотвращения зависания
cIterationsOnAge: TDBNumberEditEh; //Количество итераций на эпоху
//Этот параметр используется для других алгоритмов - для отжига, в
//нашем случае необходимо присвоить любое положительное число
btnBackTrack: TButton; // Запуск процесса поиска с возвратом
Это минимум.
Еще чекбоксы
cbBtCut: TCheckBox; // Останавливать на первом решении
cbBtPrintSolution: TCheckBox; // Печатать решение. Для больший размером доски количество решений может быть более 100500, поэтому можно распечатку конкретных решений в лог разумнее отключать.
Создаем новый модуль (pdaQueensBacktrack.pas).
Подключаем библиотечные модули:
uses
pdaMIRObjects, pdaBackTrack;
Описываем наши классы решения, окружения и контроллера.
Класс решения
Является самым сложным. Решение собственно определяет объект расчета.
Interface
…
type
...
TpdaQueensBackTrackSolution = class(TpdaBackTrackSolution)
private
FM: array[1..cDIMBOARD_VERT] of integer;
FStep: integer;
protected
function GetNumCurrentAlternative: Integer; override;
function GetNumCurrentStep: Integer; override;
public
function SolutionDone: Boolean; override;
procedure InitializeSolultion; override;
procedure DoFirstStep;override;
procedure DoNextStep(var aOverflow: Boolean);override;
procedure DoNextAlt(var aResult: Boolean);override;
function Suitable: Boolean;override;
procedure BackTrack;override;
end;
Минимальный набор методов, которые нужно реализовать в решении для алгоритма перебора с возвратом, определен в TpdaBackTrackSolution, необходимо только определить их в своем классе (override). Названия методов являются прямыми отсылками к описанию алгоритма и не вызывают вопросов. Как их реализовывать и какими требованиями они должны соответствовать, описано далее.
По вопросу алгоритмизации задачи ферзей.
Располагаем все ферзи по горизонталям. Изменять положение каждого ферзя можно только по вертикальной координате.
FM: array[1..cDIMBOARD_VERT] of integer; - одномерный массив, определяющий расположение каждого ферзя по горизонтали.
FStep: integer; - Шаг.
Альтернативой является расположение ферзя на i-ой горизонтали. То есть FM[i].
procedure InitializeSolultion; override; - инициализация решения. Вначале ферзей на доске нет, забиваем массив нулями.
implementation
…
procedure TpdaQueensBackTrackSolution.InitializeSolultion;
var
i: integer;
begin
for i := 1 to cDIMBOARD_VERT do begin
FM[i] := 0;
end;
end;
procedure DoFirstStep;override; - приводит решение в состояние первого шага, с которого начинается перебор.
implementatin
…
procedure TpdaQueensBackTrackSolution.DoFirstStep;
begin
FStep := 1;
end;
function SolutionDone: Boolean; override; - возвращает True, если решение найдено.
Для задачи ферзей решение найдено в том случае, если алгоритм дошел до последней горизонтали. Следует учитывать, что сначала алгоритм проверяет, подходил ли альтернатива (функция Suitable, о ней ниже). Если альтернатива подходит, проверяется SolutionDone. Если SolutionDone = True, то Environment сигнализирует контроллеру о нахождении решения и тот вызывает SolutionDoneFindedNotiry. Затем, если мы определили Cut = True (см. далее) прогон останавливается, иначе прогон продолжается.
implementatin
…
function TpdaQueensBackTrackSolution.SolutionDone: Boolean;
begin
result := (FStep = cDIMBOARD_VERT);
end;
procedure DoNextStep(var aOverflow: Boolean);override; - переводит решение в состояние следующего шага и возвращает True, если текущий шаг не выходит за верхний предел множества шагов.
implementation
…
procedure TpdaQueensBackTrackSolution.DoNextStep(var aOverflow: Boolean);
begin
Inc(FStep);
result := (FStep <= cDIMBOARD_VERT);
end;
procedure DoNextAlt(var aResult: Boolean);override; - переходит к следующей альтернативе и возвращает aResult = True, если она есть, либо возвращает aResult = False в противном случае.
implementation
...
procedure TpdaQueensBackTrackSolution.DoNextAlt(var aResult: Boolean);
begin
if FM[FStep] < cDIMBOARD_HOR then begin
Inc(FM[FStep]);
aResult := True;
end
else begin
aResult := False;
end;
end;
function Suitable: Boolean;override; -самая главная и сложная функция. Производит расчет текущего решения (шаг и альтернатива) и дает True, если такая альтернатива является подходящей.
Отличия перебора с возвратом от, например, отжига или генетического алгоритма в том, что определяется не числовое значение (приспособленность) а булево - подходит нам эта альтернатива или нет. Если нет, то мы далее не двигаемся, как бы мы не были близки к решению.
implementation
...
function TpdaQueensBackTrackSolution.Suitable: Boolean;
//Поскольку для алгоритма перебора с возвратом
//выбрана кодировка размещения ферзей, при котором они могут
//размещаться на одинаковых вертикалях
//то необходимо проверять как диагонали, так и вертикали
//это увеличивает затраты :(
var
i, j: integer;
//conflicts2: integer;
diagonals: array[1..2, 1..2*cDIMBOARD_VERT - 1] of integer;
vert: array[1..cDIMBOARD_VERT] of integer;
begin
//conflicts2 := 0;
Result := True;
for i := 1 to cDIMBOARD_VERT do begin
vert[i] := 0;
end;
for i := 1 to 2 * cDIMBOARD_VERT - 1 do begin
diagonals[1, i] := 0;
diagonals[2, i] := 0;
end;
for i := 1 to cDIMBOARD_VERT do begin
j := FM[i];
if j > 0 then begin
Inc(vert[j]);
Inc(diagonals[1, i - j + cDIMBOARD_VERT]);
Inc(diagonals[2, i + j - 1]);
end;
end;
for i := 1 to cDIMBOARD_VERT do begin
if vert[i] > 1 then begin
Result := False;
Break;
end;
end;
if not Result then
Exit;
for i := 1 to 2 * cDIMBOARD_VERT - 1 do begin
if
(diagonals[1, i] > 1)
or (diagonals[2, i] > 1)
then begin
Result := False;
Break;
end;
{
if diagonals[1, i] > 1 then
conflicts2 := conflicts2 + diagonals[1, i];
if diagonals[2, i] > 1 then
conflicts2 := conflicts2 + diagonals[2, i];
}
end;
//FEnergy := conflicts2;
end;
procedure BackTrack;override; - Возврат. Как много в этом звуке.
implementation
…
procedure TpdaQueensBackTrackSolution.BackTrack;
begin
if (FStep <= cDIMBOARD_VERT) and (FStep > 0) then begin
FM[FStep] := 0;
end;
Dec(Fstep);
end;
Класс окружающей среды
Interface
…
type
…
TpdaQueensBacktrackEnvironment = class(TpdaBacktrackEnvironment)
public
procedure GenerateObjects;override;
procedure DestroyObjects;override;
end;
Эти две процедуры определены в базовом классе TpdaMIREnvironment в модуле pdaMIRObjects. Нам необходимо их override, а в них создать объекты и удалить. У алгоритма перебора с возвратом только одна переменная решения - Fsolution. К слову, у генетического алгоритма в окружающей среде множество переменных решений, которые необходимо создавать.
implementation
…
{ TpdaBacktrackQueensEnvironment }
procedure TpdaQueensBacktrackEnvironment.GenerateObjects;
begin
FSolution := TpdaQueensBackTrackSolution.Create;
inherited;
end;
procedure TpdaQueensBacktrackEnvironment.DestroyObjects;
begin
FSolution.Free;
inherited;
end;
Класс контроллера
Interface
…
type
…
TpdaQueensBacktrackEnvironmentController = class(TpdaMIREnvironmentController)
private
FDateTimeBegin: TDateTime;
FDateTimeEnd: TDateTime;
public
procedure EndIterationNotify; override;
procedure SolutionDoneFindedNotiry; override;
procedure BeginSimulationNotify; override;
procedure EndSimulationNotify; override;
end;
Соответственно, реализуем сообщение окончания итерации - для вывода номера текущей итерации, сообщение о нахождении решения, начала и окончания поиска (в терминах библиотеки - симуляции).
implementation
…
{ TpdaQueensBacktrackEnvironmentController }
procedure TpdaQueensBacktrackEnvironmentController.BeginSimulationNotify;
begin
inherited;
FDateTimeBegin := Now;
with QueensMainForm do begin
cLog.Lines.Add(
'Начало поиска решения задачи ферзей методом BackTrack (' +
DateTimeToStr(FDateTimeBegin) + ')');
end;
Application.ProcessMessages;
end;
procedure TpdaQueensBacktrackEnvironmentController.EndIterationNotify;
var
c: TCountIteration;
begin
c := Environment.CurrentIteration;
if (c mod 100000) = 0 then begin
with QueensMainForm do begin
with pCurrentIteration do begin
Caption := IntToStr(c);
end;
{
with pBtCurrentStep do begin
Caption := IntToStr((Environment as TpdaBacktrackQueensEnvironment).NumCurrentStep);
end;
with pBtCurrentAlternative do begin
Caption := IntToStr((Environment as TpdaBacktrackQueensEnvironment).NumCurrentNumAlternative);
end;
}
end;
Application.ProcessMessages;
end;
end;
procedure TpdaQueensBacktrackEnvironmentController.EndSimulationNotify;
var
c: TCountIteration;
cword: String;
diff: TDateTime;
begin
inherited;
FDateTimeEnd := Now();
c := Environment.CurrentIteration;
with QueensMainForm do begin
with cResultTotalIteration do begin
Caption := IntToStr(c);
end;
QStrings.Q_NumToStr(c, cword, nsFemale or nsShort);
with cResultTotalIteration do begin
Value := c;
Hint := cword;
end;
with cBtResultCountSolutions do begin
Value := (Environment as TpdaQueensBacktrackEnvironment).CountSolutionDone;
Repaint;
end;
cLog.Lines.Add(
'Завершение поиска решения задачи ферзей методом BackTrack ('
+ DateTimeToStr(FDateTimeEnd) + ')');
end;
diff := FDateTimeEnd - FDateTimeBegin;
QueensMainForm.cSimulateTime.Text := TimeToStr(diff);
Application.ProcessMessages;
end;
procedure TpdaQueensBacktrackEnvironmentController.SolutionDoneFindedNotiry;
var
c: integer;
i: integer;
j: integer;
s: String;
begin
inherited;
c := (Environment as TpdaQueensBacktrackEnvironment).CountSolutionDone;
if (c mod 1000) = 0 then begin
with QueensMainForm do begin
with cBtResultCountSolutions do begin
Value := c;
end;
end;
Application.ProcessMessages;
end;
if QueensMainForm.cbBtPrintSolution.Checked then begin
with QueensMainForm do begin
cLog.Lines.Add('Найдено решение:');
for i := 1 to cDIMBOARD_VERT do begin
s := '';
for j := 1 to cDIMBOARD_VERT do begin
if j = ((Environment as TpdaQueensBacktrackEnvironment).FSolution as TpdaQueensBackTrackSolution).FM[i] then begin
s := s + '*';
end
else begin
s := s + '+';
end;
end;
cLog.Lines.Add(s)
end;
end;
end;
end;
Здесь много кода, но это все тупой код. Он просто организует вывод информации на экран - в поля и текстовку в текстовое поле лога. Единственно, на что стоит обратить внимание, это способ получения информации по количеству полученных решений (хранится в окружающей среде)
c := (Environment as TpdaQueensBacktrackEnvironment).CountSolutionDone;
и информации из самого решения
for i := 1 to cDIMBOARD_VERT do begin
s := '';
for j := 1 to cDIMBOARD_VERT do begin
if j = ((Environment as TpdaQueensBacktrackEnvironment).FSolution as TpdaQueensBackTrackSolution).FM[i] then begin
s := s + '*';
end
else begin
s := s + '+';
end;
end;
cLog.Lines.Add(s)
end;
Организация запуска алгоритма
В классе главной формы в implementation uses подключаем модуль pdaQueensBacktrack с нашей реализацией. Добавляем событие FormCreate.
Добавляем процедуру SimulateLifeQueensBackrack.
unit pdaQueensMainForm;
interface
uses
...;
type
TQueensMainForm = class(TForm)
…
procedure FormCreate(Sender: TObject);
private
...
procedure SimulateLifeQueensBackrack;//Поиск решения задачи ферзей методом перебора с возвратом
end;
var
QueensMainForm: TQueensMainForm;
Environment: TpdaMIREnvironment;
Controller: TpdaMIREnvironmentController;
implementation
uses pdaQueensBacktrack;
{$R *.dfm}
…
procedure TQueensMainForm.FormCreate(Sender: TObject);
begin
cTotalIterations.Value := 5000000;
cIterationsOnAge.Value := 100;
end;
...
procedure TQueensMainForm.SimulateLifeQueensBackrack;
begin
cLog.Lines.Clear;
Environment := TpdaQueensBacktrackEnvironment.Create; // создание окружающей среды
Controller := TpdaQueensBacktrackEnvironmentController.Create; //создание контроллера
Controller.Environment := Environment;//Подключение окружающей среды к контроллеру
with Environment do begin
TotalIteration := cTotalIterations.Value;
IterationsOnAge := cIterationsOnAge.Value;
end;
with Environment as TpdaQueensBacktrackEnvironment do begin
Cut := cbBtCut.Checked;
end;
try
with Environment do begin
GenerateObjects; //Создание объектов
InitObjects; //Их инициализация
end;
//Нахождение решения
(Environment as TpdaQueensBacktrackEnvironment).GetSolutions;
finally
Environment.Free;
end;
end;
…
end.
Значение общего количества итераций в cTotalIterations следует задавать большее, чем требуется для решения задачи.
Сначала создается окружающая среда и контроллер. В контреллере указыавется окружающая среда. Задаются параметры окружающей среды: общее количество итераций, итераций на эпоху (для перебора с возвратом значение не актуально, задавайте 100) и единственный параметр, специфичный перебору с возвратом - Cut, то есть прерывать ли перебор после нахождения первого решения.
Затем, используя окружающую среду, создаются объекты, они инициализируются и, наконец, находятся решения.
Этот код в SimulateLifeQueensBackrack типовой и используется для всех задач перебора с возвратом. Он также на 95% совпадает с вызовом других алгоритмов - алгоритма отжига и генетического алгоритма. Различие идет в основном только в блоке задания параметров:
…
with Environment as TpdaQueensBacktrackEnvironment do begin
Cut := cbBtCut.Checked;
end;
...
Вот, в общем-то и все.
Самое тяжелое в работе с данным фреймворком остается только программирование задачи - функция определения допустимости альтернативы.
Результаты прогона моего тестового приложения в следующей главе.
UPD1:
Добавил вложение, см. ниже.
За это время оптимизировал код процедуры Suitable, поэтому в приложении код отличается от вышеприведенного. Сделал размер доски произвольной, пользователь может задавать его.
В приложении - исходники Queens.exe - главная форма и модуль pdaQueensBacktrack.
Приложение из этих исходников Вы не построите, необходима библиотека MIR. Зато можно ознакомится с примером использования.
Если Вам необходима будет реализация алгоритма перебора с возвратом, пишите на
Предыдущая: 01. Перебор с возвратом - описание алгоритма
Далее: 03. Эксперименты и анализ реализации
Оглавление: Перебор с возвратом