Реферат: Программирование на языке CLIPS
;; reason объектов claim.
;; ПРИМЕЧАНИЕ. Это правило не используется для
;; распаковки метавысказываний.
(defrule unwrap-true
?W <- (world (tag ?N) (scope truth) (task check)
(done 0))
?S <- (statement (speaker ?X)
(claim ?P&: (not (eg ?P SAY)) $?Y)
(done 0))
=>
(printout
t crlf
“Assuming “ T ?X “ and “ ?P $?Y “ in world “ ?N
;; “Предполагается “ N “ ?X “ and “ ?P $?Y “ в мире “ ?N
t crlf
)
;; Зафиксировать, что высказывание было распаковано
;; в предположении о его правдивости.
(modify ?S (tag ?N) (done 1))
;; Зафиксировать в объекте world, что высказывание
;; распаковано.
(modify ?W (done 1))
;; Предположим, что персонаж в текущем «мире» является
;; правдолюбцем.
(assert (claim (content T ?X) (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
;; “Предполагается “ Т ?Х “ и “ ? Z “ говорит “ $?Y
;; “ в мире “ ?N
t crlf
)
;; Зафиксировать, что высказывание было распаковано
;; в предложении о его правдивости.
(modify ?S (tag ?N) (done 1))
;; Предположим, что персонаж в текущем «мире» является
;; правдолюбцем.
(assert (claim (content T ?X) (reason ?N)
(scope truth)))
;; Зафиксировать в объекте 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 (eq ?P NOT) (eq ?P SAY))) $?Y)
(tag ?N) (done 1))
=>
(printout
t crlf
“Assuming “ F ?X “ and NOT “ in world “ ?N
;; “ Предполагается “ F ?X “ и НЕ “ ?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)))
)
;;----------------------------------------------------------------------
;; ЕСЛИ объект world базируется на предположении о
;; лживости метавысказывания,
;; ТО предложить, что персонаж лжец.
;; Каких-то предположений об истинности
;; утверждения не делается.
;; ПРИМЕЧАНИЕ. Правило используется только для работы с
;; метавысказываниями, которые не содержат отрицаний.
;; Правило не может обрабатывать метавысказывания вида:
;; А: «В говорит, что он лжец.»
;; или А: «В говорит, что он не лжец.»
(defrule unwrap-false-state
?W <- (world (tag ?N) (scope falsity) (task check))
?S <- (statement (speaker ?X) (claim SAY ?Z $?Y)
(tag ?N) (done 1))
=>
(printout
t crlf
“Assuming “ F “ “?X “ and NOT “ ?Z “ says “ $?Y
“ in world “ ?N
;; “Предполагается “ F “ “ ?X “ и НЕ “ ?Z “ говорит “ $?Y
;; в мире “ ?N
t crlf
)
;; Изменить значения в поле scope текущего объекта
;; world.
(modify ?W (scope falsity) (done 2))
;; Зафиксировать, что высказывание было распаковано
;; в предложении о лживости.
(modify ?S (scope falsity) (done 2))
;; Предположить, что в текущем «мире» персонаж,
;; произнёсший метавысказывание лжец.
(assert (claim (content F ?X) (reason ?N) (scope falsity)))
)
;;----------------------------------------------------------------------
;; ЛОГИЧЕСКИЕ ОПЕРАТОРЫ
;; Правила отрицания
;;----------------------------------------------------------------------
;; ЕСЛИ некто не правдолюбец,
;; ТО он лжец.
(defrule not1
(declare (salience 5))
?F <- (claim content NOT T ?P))
=>
(modify ?F (content F ?P))
)
;;----------------------------------------------------------------------
;; ЕСЛИ некто не лжец,
;; ТО он правдолюбец.
(defrule not2
(declare (salience 5))
?F <- (claim content NOT F ?P))
=>
(modify ?F (content T ?P))
)
;;----------------------------------------------------------------------
;; Распространение отрицания на дизъюнкцию.
(defrule not-or
(declare (salience 5))
?F <- (claim (content NOT OR ?P ?X ?Q ?Y))
=>
(modify ?F (content AND (flip ?P) ?X (flip ?Q) ?Y))
)
;;----------------------------------------------------------------------
;; Распространение отрицания на конъюнкцию.
(defrule not-or
(declare (salience 5))
?F <- (claim (content NOT AND ?P ?X ?Q ?Y))
=>
(modify ?F (content OR (flip ?P) ?X (flip ?Q) ?Y))
)
;;----------------------------------------------------------------------
;; Устранение конъюнкции.
(defrule conj
(world (tag ?N) (scope ?V) (task check)
(context ?L))
(claim (content AND ?P ?X ?Q ?Y) (reason ?N)
(scope ?V) (context ?L)
=>
(assert (claim (content ?P ?X) (reason ?N)
(scope ?V) (context ?L))
(assert (claim (content ?Q ?Y) (reason ?N)
(scope ?V) (content ?L))
)
;;----------------------------------------------------------------------
;; ОБРАБОТКА ДИЗЪЮНКТИВНЫХ УТВЕРЖДЕНИЙ
;;----------------------------------------------------------------------
;; ЕСЛИ мы имеем дело с дизъюнктивным утверждением,
;; т.е. context = 0,
;; ТО сначала проанализировать левый дизъюнкт.
;; ПРИМЕЧАНИЕ. Устанавливается значение 1 как в поле
;; context объекта world, так и в поле context нового
;; объекта claim.
(defrule left-disjunct
?W <- (world (tag ?N) (task check) (scope ?V)
(content 0))
(claim (content OR ?P ?X ?Q ?Y) (reason ?N)
(scope ?V) (content 0))
=>
(assert (claim (content ?P ?X) (reason ?N)
(scope ?V) (context 1))
)
;;----------------------------------------------------------------------
;; ЕСЛИ при анализе левого дизъюнкта обнаружено
;; противоречие,
;; ТО проанализировать правый дизъюнкт.
(defrule right-disjunct
?W <- (world (tag ?N) (task contra) (context 1))
(claim (content OR ?P ?X ?Q ?Y) (reason ?N)
(scope ?V))
=>
(assert (claim (content ?Q ?Y) (reason ?N)
(scope ?V) (context 2)))
(modify ?W (task check) (context 2))
)
;;----------------------------------------------------------------------
;; ЕСЛИ выполнен откат к анализу правого дизъюнкта,
;; ТО установить соответствующий контекст.
(defrule resume-disjunct
?W <- (world (tag ?N) (task back) (context 1))
(claim (content OR ?P ?X ?Q ?Y) (reason ?N)
(scope ?V))
=>
(assert (claim (content ?Q ?Y) (reason ?N)
(scope ?V) (context 2)))
(modify ?W (task check) (context 2))
)
;;----------------------------------------------------------------------
;; ЕСЛИ анализ обоих дизъюнктов в предположении о
;; правдивости персонажа привёл к противоречию
;; в том же самом «мире»,
;; ТО выполнить анализ, предполагая, что персонаж лжёт.
(defrule false-disjuncts
?W <- (world (tag ?M) (scope truth) (task contra)
(prior 0) (context 2))
(not (claim (reason ?M) (context 2)))
=>
(modify ?W (scope falsity) (task check) (context 0))
)
;;----------------------------------------------------------------------
;; ЕСЛИ аналих в предположении о правдивости персонажа
;;привёл к противоречию с другим «миром»,
;; ТО выполнить анализ, предполагая, что персонаж лжёт.
(defrule other-world
?W <- (world (tag ?N) (scope truth) (task contra)
(prior ?M&~0) (context 0))
=>
(modify ?W (scope falsity) (task check))
)
;;----------------------------------------------------------------------
;; ОБРАБОТКА ПРОТИВОРЕЧИЙ
;;----------------------------------------------------------------------
;; ЕСЛИ обнаруживается противоречие между предположением
;; и производными от него фактами в пределах одного и
;; того же мира и в одном и том же контексте,
;; ТО зафиксировать противоречия и удалить
;; противоречивые утверждения (объект claim)
;; из базы фактов.
(defrule contradiction
(declare (salience 100))
?W <- (world (tag ?N) (task check) (scope ?V)
(context ?S))
?P <- (claim (content ?F ?X) (scope ?V) (reason ?N)
(context ?S))
?Q <- (claim (content ?G&: (not (eq ?G ?F)) ?X)
(scope ?V) (reason ?N) (context ?S))
=>
(printout
t crlf
“CONTRADICTION: “ ?F ?X “ versus “
?G ?X “ in world “ ?N
;; “ПРОТИВОРЕЧИЕ между: “ ?F ?X “ и “ ?G ?X “ в мире “ ?N
t crlf)
(retract ?P)
(retract ?Q)
(modify ?W (task contra))
)
;;----------------------------------------------------------------------
;; ЕСЛИ обнаруживается противоречие между предположением
;; и производными от него фактами в пределах одного и
;; того же мира, но в разных конекстах,
;; ТО зафиксировать проиворечие.
(defrule transcontext
(declare (salience 90))
?W <- (world (tag ?N) (task check) (scope ?V)
(context ?T))
(claim (content ?F ?X) (scope ?V) (reason ?N)
(context ?S&: (< ?S ?T)))
(claim (content ?G&: (not (eq ?G ?F)) ?X) (scope ?V)
(reason ?N) (context ?T))
=>
(printout t crlf
“TRANSCONTEXT CONTRADICTION: “ ?F ?X “ versus “
?G ?X “ in world “ ?N
;; “ТРАНСКОНТЕКСТНОЕ ПРОТИВОРЕЧИЕ между: “ ?F ?X
;; “ и “ ?G ?X “ в мире “ ?N
t crlf)
(modify ?W (task contra))
)
;;----------------------------------------------------------------------
;; ЕСЛИ обнаруживается противоречие между
;; текущим «миром» в предположении о правдивости
;; и ранее покинутым «миром»,
;; ТО зафиксировать противоречие.
(defrule transworld-truth
(declare (salience 80))
?W <- (world (tag ?N) (scope truth) (task check)
(upper 0))
;; В текущем «мире» имеется утверждение,
;; противоречащее утверждению в другом «мире».
(claim (content ?F ?X) (reason ?N))
;; «Мир», с которым обнаружен конфликт, имеет
;; индентефикатор, меньший, чем текущий «мир»,
;; т.е. сформирован раньше.
(claim (content ?G&: (not (eq ?G ?F)) ?X)
(reason ?M&: (< ?M ?N)))
=>
(printout
t crlf
“TRANSWORLD CONTRADICTION: “ ?F ?X “ versus “
?G ?X “ in world “ ?N “ I “ ?M
;; “МЕЖМИРОВОЕ ПРОТИВОРЕЧИЕ: “ ?F ?X “ противоречит “
;; ?G ?X “ в мирах “ ?N “ I “ ?M
t crlf)
(modify ?W (task contra))
)
;;----------------------------------------------------------------------
;; ЕСЛИ обнаруживается противоречие между
;; текущим «миром» в предположении о лживости
;; и ранее покинутым «миром»,
;; ТО подготовиться к выполнению отката в ранее
;; покинутый «мир».
(defrule transworld-falsity
(declare (salience 80))
?W <- (world (tag ?N) (scope falsity)
(task check) (upper 0))
(claim (content ?F ?X) (reason ?N))
(claim
(content ?G&: (not (eq ?G ?F)) ?X)
(reason (?M&: (< ?M ?N)))
=>
(printout
t crlf
“TRANSWORLD CONTRADICTION: “ ?F ?X “ versus “
?G ?X “ in worlds “ ?N “ I “ ?M
;; “МЕЖМИРОВОЕ ПРОТИВОРЕЧИЕ: “ ?F ?X “ проиворечит “
;; ?G ?X “ в мирах “ ?N “I “ ?M
t crlf
(modify ?W (task contra) (prior ?M))
)
;;----------------------------------------------------------------------
;; ЕСЛИ обнаружено противоречие между внедрённым «миром»
;; метавысказывания и ранее покинутым «миром»,
;; ТО удалить высказывание, связанное с внедрённым «миром».
(defrule upper-world
(declare (salience 80))
?W <- (world (tag ?N) (task check) (upper ?U&~0))
(claim (content ?F ?X) (reason ?N)
(claim
(content ?G&: (not (eq ?G ?F)) ?X)
(reason ?M&: (< ?M ?N)))
?S <- (statement (tag ?N) (reason ?U))
=>
(printout
t crlf
“TRANSWORLD CONTRADICTION: “ ?F ?X “versus “
?G ?X “ in worlds “ ?N “ I “ ?M
;; “МЕЖМИРОВОЕ ПРОТИВОРЕЧИЕ: “ ?F ?X “ проиворечит “
;; ?G ?X “ в мирах “ ?N “ I “ ?M
t crlf)
(retract ?S)
(modify ?W (task contra) (prior ?U))
)
;;----------------------------------------------------------------------
;; ОПЕРАЦИИ УДАЛЕНИЯ
;;----------------------------------------------------------------------
;; Удаление дизъюнкта.
(defrule clean-context
(declare (salience 50))
(world
(tag ?N)
(task ?T&: (or (eq ?T contra) ( eq ?T back))
(context ?S&~0))
?F <- (claim (reason ?N) (context ?S))
=>
(retract ?F)
)
;;----------------------------------------------------------------------
;; ЕСЛИ текущий мир проанализирован только
;; в предположении о правдивости,
;; ТО проанализировать его предполагая
;; лживость персонажа.
(defrule switch-scope
(declare (salience 40))
?W <- (world (tag ?N) (scope truth) (task contra)
(context ?C&~1)
=>
(modify ?W (scope falsity) (task check))
)
;;----------------------------------------------------------------------
;; Удалить все утверждения, сделанные в предположении
;; о правдивости, перед тем как анализировать
;; предположение о лживости.
(defrule sweep-claims
(declare (salience 100))
(world
(tag ?N) (scope truth) (context ?C&~1)
(task ?T&: (or (eq ?T contra) (eq ?T back))))
?F <- (claim (reason ?N) (scope truth (context ?D&~1))
=>
(retract ?F)
)
;;----------------------------------------------------------------------
;; Удалить все объекты statement, основанные на предположении
;; о правдивости, перед тем как анализировать
;; предположение о лживости.
(defrule sweep-statements
(declare (salience 100))
(world
(tag ?N) (task ?T&: (or (eq ?T contra) (eq ?T back)))
(scope truth) (context 0)
?F <- (statement (reason ?N) (scope truth))
=>
(retract ?F)
)
;;----------------------------------------------------------------------
;; Удалить утверждения, связанные с «миром»,
;; в котором обнаружены противоречия.
(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 ?M) (task back))
?F <- (claim (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))
)
;;----------------------------------------------------------------------
;; ПЕРЕХОД К АНАЛИЗУ СЛЕДУЮЩЕГО «МИРА» И
;; ВЫВОД ОТЧЕТА О РЕЗУЛЬТАТАХ
;;----------------------------------------------------------------------
;; Переход к анализу следующего «мира»,
;; ЕСЛИ никакие другие правила не ожидают активизации,
;; ТО анализ текущего «мира» завершён и
;; можно приступить к формированию нового «мира»,
;; если имеются необработанные высказывания.
;; ПРИМЕЧАНИЕ. Это правило имеет приоритет,
;; более низкий, чем все прочие правила,
;; исключая правило вывода результатов.
(defrule move
(declare (salience -50))
;; Существует «мир», сформированный на основе
;; исходного высказывания.
?W <- (world (tag ?N&: (> ?N 0)) (task check)
;; В базе фактов отсутствуют объекты world,
;; созданные позже текущего.
(not (world (tag ?T&: (> ?T ?N))))
;; В базе фактов имеется высказывание, подготовленное
;; к созданию нового объекта world.
(statement (reason 0) (done 0))
=>
;; Сформирован новый объект world на основе
;; этого объекта statement.
(assert (world (tag (+ ?N 1))))
)
;;----------------------------------------------------------------------
;; ЕСЛИ отсутствуют противоречия в объектах world,
;; ТО распечатать результаты.
;; ПРИМЕЧАНИЕ. Это правило будет активизироваться
;; повторно до тех пор, пока не будет выведена
;; непротиворечивая интерепритация.
(defrule report-result
(declare (salience -40))
(not (world (task contra)))
(not (statement (reason 0) (done 0)))
(statement (tag ?N) (done ?M&~0))
(claim (content ?P ?X) (reason ?N)
=>
(printout
t crlf
“RESULT: “ ?P ?X “ from statement “ ?N
;; “РЕЩУЛЬТАТ: “ ?P ?X “ из высказывания “ ?N
t crlf)
)
;;----------------------------------------------------------------------
;; ЕСЛИ противоречие остаётся и после анализа всех точек отката
;; и нет больше правил, которые можно было бы активизировать,
;; ТО прекратить процесс вычислений.
(defrule sanity-check
(declare (salience -100))
(world (tag ?N) (task ?T&: (or (eq ?T contra)
(eq ?T back))))
(not (world (tag ?M&: (< ?M ?N)) (scope truth)
(task check)))
=>
(printout
t crlf
“FAIL: Statements inconsistent, detected in world “ ?N
;; “РЕШЕНИЕ НЕ НАЙДЕНО: Высказывания противоречивы,
;; обнаружены в мире “ ?N
t crlf)
(halt)
)
Я не сомневаюсь в том, что эту программу можно совершенствовать и далее. Можно, например, попытаться использовать технологию отката, основанную на комбинировании направленных и хронологических методов пойска точки возврата. Но и в том виде, в каком она здесь представлена, программа справляется со всеми сформулированными в тексте приложения задачами. Анализируя текст программы, вы можете убедиться в том, что язык CLIPS позволяет реализовать многие из описанных в данной книге технологий, в частности:
· методику прямого логического вывода, которая обеспечивает разрешение конфиликтов;
· целенаправленный логический вывод с использованием лексем задач;
· анализ множества контекстов при разных исходных предпроложениях.
На примере этой программы вы также могли убедиться в том, что несмотря на модульную структуру, расширение её функциональных возможностей сопряжено с определённой модификацией ранее разработанных модулей (правил), которые должны учитывать изменения, вносимые в структуру данных.
А.5. СТИЛЬ ПРОГРАММИРОВАНИЯ НА ЯЗЫКЕ CLIPS
В главе 17 был представлен обзор инструментальных средств конструирования экспертных систем и ряд рекомендаций, касающихся методики их проектирования. Многие из описанных в той главе средств имеют функциональные возможности, весьма близкие к тем которые вы можете найти в CLIPS. Большинство рекомендаций, относящихся к методике проектирования систем, основанных на правилах, сохраняют свою силу и при использовании в качестве основного инструмента проектирования языка CLIPS. В частности, работая с CLIPS, нужно стараться так организовать систему правил, чтобы каждое из них было как можно проще. Я бы рекомендовал вновь перечитать главу 17 после того, как вы внимательно проанализируете описанную в этом Приложении программу.
Эта программа является относительно простой и включает всего 35 правил, тогда как в практических экспертных системах их может быть значительно больше. Наприме, в прототипе системы R1/XCON, который был разработан в 1980 году, содержалось около 750 правил, причём по мере совершенствования системы их число росло и к 1984 году достигло 3300. В среднем каждое правило в R1 анализирует шесть условий и выполняет три действия.
Как и при программировании любфх других задач, ключевым условием разработки «хорошого» программного кода является правильный выбор набора абстрактных понятий, которыми должна манипулировать программа, и набора операций, которые она должна выполнять. Первое условие поможет рационально выбрать структуру объектов и форму представления условий в левой части правил, а второе – рационально организовать действия в правой части. Как было сказано в разделе А.3, использование объектов и обработчиков сообщений позволяет успешно решить задачу рациональной организации данных и процедур в программе.
