Реферат: Программирование на языке CLIPS

)

;;----------------------------------------------------------------------

;; ЕСЛИ некто не лжец,

;; ТО он правдолюбец.

(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, использование объектов и обработчиков сообщений позволяет успешно решить задачу рациональной организации данных и процедур в программе.