Голубев Кирилл, ЛХФ 4-5

Решение логической задачи эвристическим алгоритмом А*


Задание:

Трем миссионерам и трем каннибалам необходимо переправиться на другой берег реки. На берегу реки находится лодка (без гребца), которая может вместить не более 2-х человек. Необходимо организовать переправу так, чтобы на одном берегу количество каннибалов не превышало количество миссионеров.

Решение задачи:

Создаем шаблон ситуации задачи, который характеризует состояния каждой из вершин графа:
(deftemplate Field
     (slot m_1 (type NUMBER))			;кол-во миссионеров на 1 берегу
     (slot m_2 (type NUMBER))			;кол-во миссионеров на 2 берегу
     (slot k_1 (type NUMBER))			;кол-во каннибалов на 1 берегу
     (slot k_2 (type NUMBER))			;кол-во каннибалов на 2 берегу
     (slot lod (type NUMBER))			;положение лодки (1 – берег 1, 2 – берег 2)
     (slot Level(type NUMBER)) 			; Уровень дерева
     (slot Id (type NUMBER)(default 0)) 	; Уникальный номер вершины
     (slot State(type NUMBER)(default 0)) 	; Принадлежность списку узлов
     (slot From (type NUMBER)) 			; Номер вершины родителя
     (slot Exp (type NUMBER))    		; Значение целевой функции
)
Так как идентификатор Id каждой текущей ситуации должен быть уникальным, то целесообразно присваивать новой ситуации идентификатор на единицу больший, чем Id предыдущей ситуации. Хранить номер предыдущей ситуации будем в глобальнопеременной ?*Id*, а вычислять Id новой ситуации будем, используя функцию Get_Id():
;; определение глобальной переменной
(defglobal
  ?*Id* = 0 
) 
;; функция вычисления уникального идентификатора текущего состояния
(deffunction Get_Id()
  (bind ?*Id* (+ ?*Id* 1))
  ?*Id*
)
Для вычисления эвристической оценки текущей ситуации определим функцию, параметрами которой будет количество миссионеров и каннибалов, находящихся одновременно на левом или правом берегу. Функция будет возвращать 1, если количество каннибалов допустимо, т.е. они не съедят миссионеров, и 0 – впротивномслучае.
;; целевая функция (1-можно, 0-нельзя)
(deffunction W(?m1 ?m2 ?k1 ?k2)
  (bind ?a 1)
  (if (or (and (< ?m1 ?k1) (not (= ?m1 0))) (and (< ?m2 ?k2) (not (= ?m2 0)))) then (bind ?a 0) )
  ?a
)
Используя конструктор deffacts определим в базе фактов факт, который будет инициализировать исходное состояние решения задачи. Факт Field задает начальное расположение каннибалов и миссионеров, значение нулевого уровня дерева решений для этой ситуации, вычисляет значение оценочной функции и уникальный номер для этой ситуации.
;; задание исходного состояния 
(deffacts start
  (Field (m_1 3) (m_2 0)
         (k_1 3) (k_2 0)
         (lod 1)
         (Level 0) 			; Это корень дерева
         (From 0) 
         (Exp (W 3 0 3 0))		; Значение оценочной функции
         (Id (Get_Id)) 			; Уникальный номер вершины
  )>
)
Для порождения новых ситуаций следует создать 12 правил, каждое из которых соответствует одному из возможных в задаче положений каннибалов и миссионеров.
Все этих правила служит для формирования пространства состояний и в каждом из них должны выполняться следующие действия: Так как принципы создания этих правил идентичны, рассмотрим порождение новых ситуаций для факта, когда 3 каннибала, 3 миссионера и лодка находятся на 1-м берегу:
Field (State 0) (Id ?Id)  (Level ?L) (Exp ?E& :(= ?E 1)) (m_1 3) (m_2 0) (k_1 3) (k_2 0) (lod 1) 
Условная часть данного правила выполняется, если данная ситуация присутствует в базе фактов, имеет значение State = 0 и целевая функция равна Exp = 1. Из данной ситуации возможно порождение 3-х новых ситуаций: Заключительная часть правил переводит текущую ситуацию в множество CLOSED, присваивая слоту State значение 1, затем вычисляет значение целевой функции Exp для одного из новых состояний.
Затем формирует пространство состояний, порождая дочерние вершины для этой ситуации, добавляя новые факты в базу фактов, которые соответствуют элементам множества OPEN.
;;--- далее определяются 12 правил формирования пространства состояний
;;--- они имеют одинаковый приоритет, что дает случайность применения
(defrule make_new_path_1
  (declare (salience 100))
  ?f <- (Field (State 0) (Id ?Id)  (Level ?L) (Exp ?E& :(= ?E 1))
               (m_1 3) (m_2 0)
               (k_1 3) (k_2 0)
               (lod 1)   )
  =>
  (modify ?f(State 1))
  (assert (Field (m_1 1) (m_2 2)
                 (k_1 3) (k_2 0)
                 (lod 2)
                 (Level (+ ?L 1)) (From ?Id) (Id (Get_Id))
                 (Exp (W 1 2 3 0)) )
  )
  (assert (Field (m_1 3) (m_2 0)
                 (k_1 1) (k_2 2)
                 (lod 2)
                 (Level (+ ?L 1)) (From ?Id) (Id (Get_Id))
                 (Exp (W 3 0 1 2)) )
  )
  (assert (Field (m_1 2) (m_2 1)
                 (k_1 2) (k_2 1)
                 (lod 2)
                 (Level (+ ?L 1)) (From ?Id) (Id (Get_Id))
                 (Exp (W 2 1 2 1)) )
  )
)

(defrule make_new_path_2
  (declare (salience 100))
  ?f <- (Field (State 0) (Id ?Id)  (Level ?L) (Exp ?E& :(= ?E 1))
               (m_1 2) (m_2 1)
               (k_1 2) (k_2 1)
               (lod 2)   )
  =>
  (modify ?f(State 1))
  (assert (Field (m_1 3) (m_2 0)
                 (k_1 2) (k_2 1)
                 (lod 1)
                 (Level (+ ?L 1)) (From ?Id) (Id (Get_Id))
                 (Exp (W 3 0 2 1)) )
  )
  (assert (Field (m_1 2) (m_2 1)
                 (k_1 3) (k_2 0)
                 (lod 1)
                 (Level (+ ?L 1)) (From ?Id) (Id (Get_Id))
                 (Exp (W 2 1 3 0)) )
  )
)

(defrule make_new_path_3
  (declare (salience 100))
  ?f <- (Field (State 0) (Id ?Id)  (Level ?L) (Exp ?E& :(= ?E 1))
               (m_1 3) (m_2 0)
               (k_1 2) (k_2 1)
               (lod 1)   )
  =>
  (modify ?f(State 1))
(assert (Field (m_1 1) (m_2 2) (k_1 2) (k_2 1) (lod 2) (Level (+ ?L 1)) (From ?Id) (Id (Get_Id)) (Exp (W 1 2 2 1)) ) ) (assert (Field (m_1 3) (m_2 0) (k_1 0) (k_2 3) (lod 2) (Level (+ ?L 1)) (From ?Id) (Id (Get_Id)) (Exp (W 3 0 0 3)) ) ) (assert (Field (m_1 2) (m_2 1) (k_1 1) (k_2 2) (lod 2) (Level (+ ?L 1)) (From ?Id) (Id (Get_Id)) (Exp (W 2 1 1 2)) ) ) ) (defrule make_new_path_4 (declare (salience 100)) ?f <- (Field (State 0) (Id ?Id) (Level ?L) (Exp ?E& :(= ?E 1)) (m_1 3) (m_2 0) (k_1 0) (k_2 3) (lod 2) ) => (modify ?f(State 1)) (assert (Field (m_1 3) (m_2 0) (k_1 2) (k_2 1) (lod 1) (Level (+ ?L 1)) (From ?Id) (Id (Get_Id)) (Exp (W 3 0 2 1)) ) ) (assert (Field (m_1 3) (m_2 0) (k_1 1) (k_2 2) (lod 1) (Level (+ ?L 1)) (From ?Id) (Id (Get_Id)) (Exp (W 3 0 1 2)) ) ) ) (defrule make_new_path_5 (declare (salience 100)) ?f <- (Field (State 0) (Id ?Id) (Level ?L) (Exp ?E& :(= ?E 1)) (m_1 3) (m_2 0) (k_1 2) (k_2 1) (lod 1) ) => (modify ?f(State 1)) (assert (Field (m_1 1) (m_2 2) (k_1 2) (k_2 1) (lod 2) (Level (+ ?L 1)) (From ?Id) (Id (Get_Id)) (Exp (W 1 2 2 1)) ) ) (assert (Field (m_1 3) (m_2 0) (k_1 0) (k_2 3) (lod 2) (Level (+ ?L 1)) (From ?Id) (Id (Get_Id)) (Exp (W 3 0 0 3)) ) ) ) (defrule make_new_path_6 (declare (salience 100)) ?f <- (Field (State 0) (Id ?Id) (Level ?L) (Exp ?E& :(= ?E 1)) (m_1 3) (m_2 0) (k_1 1) (k_2 2) (lod 1) ) => (modify ?f(State 1)) (assert (Field (m_1 1) (m_2 2) (k_1 1) (k_2 2) (lod 2) (Level (+ ?L 1)) (From ?Id) (Id (Get_Id)) (Exp (W 1 2 1 2)) ) ) (assert (Field (m_1 2) (m_2 1) (k_1 0) (k_2 3) (lod 2) (Level (+ ?L 1)) (From ?Id) (Id (Get_Id)) (Exp (W 2 1 0 3)) ) ) ) (defrule make_new_path_7 (declare (salience 100)) ?f <- (Field (State 0) (Id ?Id) (Level ?L) (Exp ?E& :(= ?E 1)) (m_1 1) (m_2 2) (k_1 1) (k_2 2) (lod 2) ) => (modify ?f(State 1)) (assert (Field (m_1 2) (m_2 1) (k_1 2) (k_2 1) (lod 1) (Level (+ ?L 1)) (From ?Id) (Id (Get_Id)) (Exp (W 2 1 2 1)) ) ) ) (defrule make_new_path_8 (declare (salience 100)) ?f <- (Field (State 0) (Id ?Id) (Level ?L) (Exp ?E& :(= ?E 1)) (m_1 2) (m_2 1) (k_1 2) (k_2 1) (lod 1) ) => (modify ?f(State 1)) (assert (Field (m_1 0) (m_2 3) (k_1 2) (k_2 1) (lod 2) (Level (+ ?L 1)) (From ?Id) (Id (Get_Id)) (Exp (W 0 3 2 1)) ) ) ) (defrule make_new_path_9 (declare (salience 100)) ?f <- (Field (State 0) (Id ?Id) (Level ?L) (Exp ?E& :(= ?E 1)) (m_1 0) (m_2 3) (k_1 2) (k_2 1) (lod 2) ) => (modify ?f(State 1)) (assert (Field (m_1 0) (m_2 3) (k_1 3) (k_2 0) (lod 1) (Level (+ ?L 1)) (From ?Id) (Id (Get_Id)) (Exp (W 0 3 3 0)) ) ) ) (defrule make_new_path_10 (declare (salience 100)) ?f <- (Field (State 0) (Id ?Id) (Level ?L) (Exp ?E& :(= ?E 1)) (m_1 0) (m_2 3) (k_1 3) (k_2 0) (lod 1) ) => (modify ?f(State 1)) (assert (Field (m_1 0) (m_2 3) (k_1 1) (k_2 2) (lod 2) (Level (+ ?L 1)) (From ?Id) (Id (Get_Id)) (Exp (W 0 3 1 2)) ) ) ) (defrule make_new_path_11 (declare (salience 100)) ?f <- (Field (State 0) (Id ?Id) (Level ?L) (Exp ?E& :(= ?E 1)) (m_1 0) (m_2 3) (k_1 1) (k_2 2) (lod 2) ) => (modify ?f(State 1)) (assert (Field (m_1 0) (m_2 3) (k_1 2) (k_2 1) (lod 1) (Level (+ ?L 1)) (From ?Id) (Id (Get_Id)) (Exp (W 0 3 2 1)) ) ) ) (defrule make_new_path_12 (declare (salience 100)) ?f <- (Field (State 0) (Id ?Id) (Level ?L) (Exp ?E& :(= ?E 1)) (m_1 0) (m_2 3) (k_1 2) (k_2 1) (lod 1) ) => (modify ?f(State 1)) (assert (Field (m_1 0) (m_2 3) (k_1 0) (k_2 3) (lod 2) (Level (+ ?L 1)) (From ?Id) (Id (Get_Id)) (Exp (W 0 3 0 3)) ) ) )
Считается, что решение найдено если на каком-то этапе решения задачи была порождена ситуация соответствующая конечной.
В этом случае необходимо выделить все промежуточные ситуации от конечной до начальной. Данные действия выполняются в следующих правилах:
;; если решение найдено, то выделяем его
(defrule start_select_answer
  (declare (salience 500))
  ?f <-(Field (m_1 0) (m_2 3)
              (k_1 0) (k_2 3)
              (lod 2)
              (State ~2) (From ?Id)   )
   =>
  (printout t "start select answer Id-" (fact-slot-value ?f Id) crlf)
  (modify ?f (State 2))
)

;; выделяем все вершины дерева решение, присваивая им State=2
(defrule select_answer
  (declare (salience 500))
  (Field (State 2) (From ?Id))
  ?f <- (Field (Id ?Id) (State ~2))
  =>
  (modify ?f (State 2))
  (printout t "select answer Id=" ?Id " - " ?f crlf)
)
В первом правиле помечается ситуация, соответствующая найденному конечному решению, что достигается присваиванием слоту State значения 2.
Второе правило на основе значения слота From помеченной ситуации ищет непомеченную ситуацию, родительскую по отношению к уже помеченной ситуации.
Если такая ситуации есть, то она включается в список помеченных (State = 2), образующих дерево решения.
Если предыдущие правила, как более приоритетны, больше не выполняются, но при этом и целевое решение найдено,
то необходимо из базы фактов удалить все лишние промежуточные факты:
;; удапяем остальные
(defrule delete_not_answer
  (declare (salience 400))
  (Field (State 2))
  ?f <- (Field (State ~2))
  =>
  (retract ?f)
  (printout t "delete not answer" crlf)
)
Возможность окончания работы программы и ее останова будет реализовано двумя следующими правилами:
;; делаем останов если решений нет
(defrule Stop_l
  (declare (salience 200))
  (Field(State ?x))
   (not (Field(State 0|2)))
  =>
  (halt)
  (printout t "==> No Solutions" crlf)
)

;; делаем останов если решение есть
(defrule Stop_2
  (declare (salience 200))
  (Field(State 2))
  =>
  (facts)
  (halt)
  (printout t "==> Solution is Ok!" crlf)
)
Действия первого правила выполняются, если решение не найдено, то есть в базе фактов отсутствуют ситуации помеченные 0 или 2.
Второе правило выполняется, если решение найдено.