Иллюстрированный самоучитель по введению в экспертные системы

Полный листинг программы

;; Удалить утверждения, связанные с "миром",
;; в котором обнаружены противоречия.
(defrule kill-claims
(declare (salience 100)) (world (tag?N)
(task clean))?F ← (claim (reason?N))
 ›
(retract?F)
)
;; ЕСЛИ все ненужные объекты claim или statement удалены,
;; ТО удалить объект world, которому назначена задача clean,
(defrule stop-killing
(declare (salience 100))
?W ← (world (tag?N) (task clean))
(not (claim (reason?N))) ›
(retract?W)
)
;;ОПЕРАЦИИ ОТКАТА
Хронологический откат к тому "миру", который был покинут без выполнения
 анализа в предположении о лживости (поле scope содержит значение truth,
 а поле task – значение check).
(defrule undirected-falsity (declare (salience 20))
(world (tag?N) (scope falsity)
(task contra))?W ← (world (tag?M&:(<?M?N))
(scope truth) (task check)) ›
(modify?W (task back))
;;Хронологический откат к тому "миру", который был
;;покинут без завершения анализа дизъюнктов,
(defrule undirected-disjunct (declare (salience 20))
(world (tag?N) (scope falsity) (task contra))
?V ← (world (tag?M&:(<?M?N)) (task check)
(context 1)) (claim (content OR?P?X?Q?Y) (reason?M)
(scope?S)) ›
;; Дизъюнкт в ранее покинутом "мире", анализ которого
;; не был выполнен.
(assert (claim (content?Q?Y) (reason?M) (scope?S)
(context 2));
;; Зафиксировать необходимость отката в этот "мир".
(modify?V (task back))
;; Удаление объектов world.
;; ЕСЛИ выполняется откат к объекту М,
;; ТО удалить все объекты world,
;; имеющие идентификатор, больший М.
(defrule undo-world
(declare (salience 50)) (world (tag?M)
(task back))?W ← (world (tag?N&:(>?N?M))) = ›
(retract?W)
)
;; Откат к прежним высказываниям.
(defrule restate
(declare (salience 50)) (world (tag?M)
(task back))?S ← (statement (tag?N&:
(>?N?M)] (reason 0) (done?X&"0))
 ›
(modify?S (done 0))
)
;; Удаление объектов claim.
;; ЕСЛИ выполняется откат к объекту world M,
;; ТО удалить все объекты claim,
;; связанные с удаленными объектами world.
(defrule unclaim
(declare (salience 30))
(world (tag?H) (task back))
?F ← (claim (reason?N&:(>?N?M))) ›
(retract?F)
)
;; Удаление объектов statement.
;; ЕСЛИ выполняется откат к объекту world M,
;; ТО удалить все объекты statement,
;; связанные с удаленными объектами world.
(defrule unstate
(declare (salience 30))
(world (tag?M) (task back))
?F ← (statement (reason?N&:(>?N?M))) ›
(retract?F)
)
;;Возобновление процесса вычислений,
;;начиная с точки возврата.
;;ЕСЛИ все объекты world, созданные
;;после объекта М, удалены,
;;ТО повторно сформировать объект М,
;;предположив лживость высказывания.
(defrule restart
(declare (salience 20))
?W ← (world (tag?M) (scope truth)
(task back) (context?C&~1)) ›
(modify?W (scope falsity) (task check) (context 0))
)