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

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

(deftemplate world
(field tag (type INTEGER) (default 1))
(field scope (type SYMBOL) (default truth))
(field task (type SYMBOL) (default check))
(field prior (type INTEGER) (default 0))
(field upper (type INTEGER) (default 0))
(field context (type INTEGER) (default 0))
(field done (type INTEGER) (default 0))
)
;; ФУНКЦИЙ
;; Изменяет область определения предиката с Т на F
;; и наоборот.
(deffunction flip (?P)
(if (eg?P Т) then F else T)
)
;; ПРАВИЛА
Распаковка высказываний
;;ЕСЛИ объект world базируется на предположении о
;;правдивости высказывания,
;;ТО предположить, что персонаж говорит правду и что
;;высказывание истинно.
;;Значение поля TAG объекта statement передается в поле
;;reason объектов claim.
;;ПРИМЕЧАНИЕ. Это правило не используется для
;;распаковки метавысказываний. (defrule unwrap-true
?W ← (world (tag?N) (scope truth) (task check)
(done 0))?S ← (statement (speaker?X)
(claim?PS:(not (eg?P SAY)) $?Y) (done 0)) ›
(printout t crlf
"Assuming " T?X " and "?P $?Y " in world "?N
;; "Предполагается " T?X " and "?P $?Y " в мире "?N t crlf
)
;;Зафиксировать, что высказывание было распаковано
;;в предположении о его правдивости,
;;modify?S (tag?N) (done 1))
;;Зафиксировать в объекте world, что высказывание
;;распаковано, modify?W (done 1))
;;Предположим, что персонаж в текущем "мире" является
;;правдолюбцем.
(assert (claim (content Т?Х) (reason?N)
(scope truth)))
;; Предполагается, что утверждение в высказывании
;; истинно. (assert (claim (content?P $?Y) (reason?N)
(scope truth)))
)
;; ЕСЛИ объект world базируется на предположении о
;; правдивости метавысказывания,
;; ТО предположить, что персонаж говорит правду и что
;; высказывание истинно.
(defrule unwrap-true-state
?W ← (world (tag?N) (scope truth) (task check)
(done 0))?S ← (statement (speaker?X) (claim SAY?Z $?Y)
(done 0)) ›
(printout t crlf "Assuming " T?X " and "?Z " says " $?Y
" in world "?N
;; "Предполагается " T?X " и "?Z " говорит " $?Y
;; " в мире "?N t crlf
)
;; Зафиксировать, что высказывание было распаковано
;; в предположении о его правдивости.
(modify?S (tag?N) (done 1))
;; Предположим, что персонаж в текущем мире является
;; правдолюбцем.
(assert (claim (content T?X) (reason?N)
(scope truth)))
;; Зафиксировать в объекте world, что высказывание
;; распаковано. (modify?W (done 1))
;; Сформировать новый объект world для внедренного
;; высказывания и зафиксировать, что этот объект
;; является внутренним по отношению к объекту
?N. (assert (world (tag (+?N 1)) (scope truth)
(upper?N)))
;; Зафиксировать внедренное высказывание в новом
;; объекте world. (assert (statement (speaker?Z) (claim $?Y)
(reason?N)))
)
;; ЕСЛИ объект world базируется на предположении о
;; лживости высказывания,
;; ТО предположить, что персонаж лжет и что
;; высказывание ложно.
;; ПРИМЕЧАНИЕ. Это правило не используется для
;; распаковки метавысказываний.

(defrule unwrap-false
?W ← (world (tag?N) (scope falsity) (task check))
?S ← (statement (speaker?X)
(claim?P&:(not (or (eq?P NOT) (eq?P SAY))) $?Y)
(tag?N) (done 1)) ›
(printout t crlf
"Assuming " F?X " and NOT " in world "?N
;; "Предполагается " F?X " и HE "?P $?Y " в мире "?N t crlf
)
;; Зафиксировать, что высказывание анализируется
;; в предположении о его лживости.
(modify?S (scope falsity) (done 2))
;; Зафиксировать в объекте world, что анализируется
;; лживость высказывания.
(modify?W (done 2))
;; Предположим, что персонаж лжец.
(assert (claim (content F?X) (reason?N)
(scope falsity)))
;; Сформировать отрицание утверждения,
(assert (claim (content NOT?P $?Y) (reason?N)
(scope falsity))))