Иван Братко - Программирование на языке Пролог для искусственного интеллекта

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

/* ПРОГРАММА И/ИЛИ-ПОИСКА С ПРЕДПОЧТЕНИЕМ

Эта программа порождает только одно решение. Гарантируется, что это решение самое дешевое при условии, что используемая эвристическая функция является нижней гранью реальной стоимости решающих деревьев.

Дерево поиска имеет одну из следующих форм:

дер( Верш, F, С, Поддеревья) дерево-кандидат

лист( Верш, F, C) лист дерева поиска

решдер( Верш, F, Поддеревья) решающее дерево

решлист( Верш, F) лист решающего дерева

С - стоимость дуги, ведущей в Верш

F = С + H, где H - эвристическая оценка оптимального решающего дерева с корнем Верш

Список Поддеревья упорядочен таким образом, что

(1) решающие поддеревья находятся в конце списка;

(2) остальные поддеревья расположены в порядке возрастания F-оценок

*/

:- op( 500, xfx, :).

:- op( 600, xfx, --->).

и_или( Верш, РешДер) :-

расширить( лист( Верш, 0, 0), 9999, РешДер, да).

% Предполагается, что 9999 > любой F-оценки

% Процедура расширить( Дер, Предел, НовДер, ЕстьРеш)

% расширяет Дер в пределах ограничения Предел

% и порождает НовДер с "решающим статусом" ЕстьРеш.

% Случай 1: выход за ограничение

расширить( Дер, Предел, Дер, нет) :-

f( Дер, F), F > Предел, !. % Выход за ограничение

% В остальных случаях F ≤ Предел

% Случай 2: встретилась целевая вершина

расширить( лист( Верш, F, С), _, решлист( Верш, F), да) : -

цель( Верш), !.

% Случай 3: порождение преемников листа

расширить( лист( Верш, F,C), Предел, НовДер, ЕстьРеш) :-

расшлист( Верш, С, Дер1), !,

расширить( Дер1, Предел, НовДер, ЕстьРеш);

ЕстьРеш = никогда, !. % Нет преемников, тупик

% Случай 4: расширить дерево

расширить( дер( Верш, F, С, Поддеревья),

Предел, НовДер, ЕстьРеш) :-

Предел1 is Предел - С,

расширспис( Поддеревья, Предел1, НовПоддер, ЕстьРеш1),

продолжить( ЕстьРеш1, Верш, С, НовПоддер, Предел,

НовДер, ЕстьРеш).

% расширспис( Деревья, Предел, Деревья1, ЕстьРеш)

% расширяет деревья из заданного списка с учетом

% ограничения Предел и выдает новый список Деревья1

% с "решающим статусом" ЕстьРеш.

расширспис( Деревья, Предел, Деревья1, ЕстьРеш) :-

выбор( Деревья, Дер, ОстДер, Предел, Предел1),

расширить( Дер, Предел1, НовДер, ЕстьРеш1),

собрать( ОстДер, НовДер, ЕстьРеш1, Деревья1, ЕстьРеш).

% "продолжить" решает, что делать после расширения

% списка деревьев

продолжить( да, Верш, С, Поддеревья, _,

решдер( Верш, F, Поддеревья), да): -

оценка( Поддеревья, H), F is С + H, !.

продолжить( никогда, _, _, _, _, _, никогда) :- !.

продолжить( нет, Верш, С, Поддеревья, Предел,

НовДер, ЕстьРеш) :-

оценка( Поддеревья, H), F is С + H, !,

расширить( дер( Верш, F, С, Поддеревья), Предел,

НовДер, ЕстьРеш).

% "собрать" соединяет результат расширения дерева со списком деревьев

собрать( или : _, Дер, да, Дер, да):- !. % Есть решение ИЛИ-списка

собрать( или : ДД, Дер, нет, или : НовДД, нет) :-

встав( Дер, ДД, НовДД), !. % Нет решения ИЛИ-списка

собрать( или : [], _, никогда, _, никогда) :- !.

% Больше нет кандидатов

собрать( или:ДД, _, никогда, или:ДД, нет) :- !.

% Есть еще кандидаты

собрать( и : ДД, Дер, да, и : [Дер Э ДД], да ) :-

всереш( ДД), !. % Есть решение И-списка

собрать( и : _, _, никогда, _, никогда) :- !.

% Нет решения И-списка

собрать( и : ДД, Дер, ДаНет, и : НовДД, нет) :-

встав( Дер, ДД, НовДД), !. % Пока нет решения И-списка

% "расшлист" формирует дерево из вершины и ее преемников

расшлист( Верш, С, дер( Верш, F, С, Оп : Поддеревья)) :-

Верш---> Оп : Преемники,

оценить( Преемники, Поддеревья),

оценка( Оп : Поддеревья, H), F is С + H.

оценить( [], []).