Программирование на языке CLIPS

;; ТО предложить, что персонаж лжец.

;; Каких-то предположений об истинности

;; утверждения не делается.

(defrule unwrap-false-state

?W

(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)))

)

Чтобы облегчить себе жизнь, будем считать, что в метавысказывании не

может быть отрицания, т.е. мы не будем рассматривать метавысказывания вида

А: «В не говорил, что он правдолюбец».

Более того, если А говорит, что В заявил нечто, то по условиям,

принятым в головоломках этого класса, для того чтобы доказать, что А лжец,

требуется только показать, что не существует непротиворечивого «мира», в

котором В мог бы сделать правдивое утверждение. Таким образом, нам не

придётся обрабатывать отрицания в метавысказываниях и анализировать их

непротиворечивость. Указанные условия нашли своё отражение в правиле unwrap-

false-state. В этом правиле, которое активизируется, когда предположение о

правдивости персонажа не срабатывает, просто предполагается, что этот

персонаж лжец, а более глубокий анализ не проводится.

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

Ниже приведён полный листинг CLIPS-программы, которая обеспечивает

обработку составных утверждений и метавысказываний.

Эта программа предназначена для разрешения головоломок о

правдолюбцах и лжецах. Программа анализирует наличие логических

противоречий и отыскивает первую непротиворечивую интерпретацию.

Программа может обрабатывать конъюнктивные и дизъюнктивные составные

утверждения.

Программа может решать задачи с множеством высказываний и

метавысказываниями.

;; TEMPLATES

;; Объект CLAIM имеет следующие поля::

;; CONTENT – содержимое утверждения, например,

;; Т А ... означает, что А является правдолюбцем;

;; F А ... означает, что А является лжецом;

;; OR T A F B ... означает, что А является правдолюбцем

;; или В является лжецом, и т.д.

;; REASON указывает, на основании какого высказывания

;; сформировано данное утверждение.

;; Значение этого поля равно идентификатору (полю tag)

;; соответствующего объекта statement (высказывание).

;; CONTEXT ::= 0 / 1 / 2;

;; значение 0 означает глобльный контекст,

;; значение 1 означает локальный контекст левого

;; операнда,

;; значение 2 означает локальный контекст правого

;; операнда дизъюнкции.

(deftemplate claim

(multifield content (type SYMBOL))

(field reason (type INTEGER))

(field scope (type SYMBOL))

(field context (type INTEGER) (default 0))

)

;; Объект statement (высказывание связан с определённым

;; персонажем (поле speaker).

;; Высказывание сожержит утверждение (поле claim).

;; Высказывание имеет основание – причину (поле reason).

;; Если данный объект не является производным от другого

;; объекта statement, в поле reason устанавливается

;; значение 0.

;; В поле tag устанавливается уникальный числовой

;; индентификатор объекта – число, больше 0.

;; В поле DONE устанавливается одно из

;; следующих значений:

;; 0 означает, что объект ещё не обрабатывался;

;; 1 означает, что объект обрабатывался в предположении

;; о правдивости высказывания;

;; 2 означает, что объект обрабатывался в предположении

;; о лживости высказывания.

(deftemplate statement

(field speaker (type SYMBOL))

(multifield claim (type SYMBOL))

(field scope (type SYMBOL) (default truth))

(multifield reason (type INTEGER) (default 0))

(field tag (type INTEGER) (default 0))

(field done (type INTEGER) (default 0))

)

;; Объект world представляет множество утверждений,

;; сформированных при определённом предположении

;; о правдивости или лживости высказывания,

;; принадлежащего некоторому персонажу.

;; Объект имеет уникальный идентификатор

;; в поле tag, который соответствует

;; тегу высказываний.

;; Смысл допущения – истинность или лживость –

;; фиксируется в поле scope.

;; Поле TASK содержит одно из перечисленных

;; ниже значений:

;; CHECK – анализ предположений о

;; правдивости или лживости высказываний;

;; CONTRA – анализ обнаруженного противоречия;

;; CLEAN – удаляет все утверждения, созданные

;; в противоречивом «мире»;

;; BACK – откат в точку возврата;

;; QUIT – прекращение процесса.

;; Поле prior может содержать идентификатор

;; объекта world, созданного перед тем,

;; как был создан данный объект, и с которым данный

;; объект может потенциально конфликтовать.

;; Поле upper содержит идентификатор другого объекта

;; world, в который внедрён данный объект, если

;; соответствующее высказывание содержит другое

;; высказывание.

;; Например, А говорит, что В сказал, что А – лжец.

;; В поле context сохраняется текущий контекст

;; анализируемого операнда дизъюнкции.

;; Поле done содержит информацию о том, обработано ли

;; уже высказывание, на основании которого создан этот

;; объект.

(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))

)

;; ФУНКЦИИ

;; Изменяется область определения предиката с T на F

;; и наоборот.

(deffunction flip (?P)

(if (eg ?P T) then F else T)

)

;; ПРАВИЛА

;; Распаковка высказываний

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

---

;; ЕСЛИ объект world базируется на предположении о

;; правдивости высказывания,

;; ТО предположить, что персонаж говорит правду и что

;; высказывание истинно.

;; Значение поля TAG объекта statement передаётся в поле

;; reason объектов claim.

;; ПРИМЕЧАНИЕ. Это правило не используется для

;; распаковки метавысказываний.

(defrule unwrap-true

?W

(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

(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

(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

(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

(modify ?F (content F ?P))

)

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

---

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

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

(defrule not2

(declare (salience 5))

?F

(modify ?F (content T ?P))

)

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

---

;; Распространение отрицания на дизъюнкцию.

(defrule not-or

(declare (salience 5))

?F

(modify ?F (content AND (flip ?P) ?X (flip ?Q) ?Y))

)

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

---

;; Распространение отрицания на конъюнкцию.

(defrule not-or

(declare (salience 5))

?F

(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

(assert (claim (content ?P ?X) (reason ?N)

(scope ?V) (context 1))

)

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

---

;; ЕСЛИ при анализе левого дизъюнкта обнаружено

;; противоречие,

;; ТО проанализировать правый дизъюнкт.

(defrule right-disjunct

?W

(assert (claim (content ?Q ?Y) (reason ?N)

(scope ?V) (context 2)))

(modify ?W (task check) (context 2))

)

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

---

;; ЕСЛИ выполнен откат к анализу правого дизъюнкта,

;; ТО установить соответствующий контекст.

(defrule resume-disjunct

?W

(assert (claim (content ?Q ?Y) (reason ?N)

(scope ?V) (context 2)))

(modify ?W (task check) (context 2))

)

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

---

;; ЕСЛИ анализ обоих дизъюнктов в предположении о

;; правдивости персонажа привёл к противоречию

;; в том же самом «мире»,

;; ТО выполнить анализ, предполагая, что персонаж лжёт.

(defrule false-disjuncts

?W

(modify ?W (scope falsity) (task check) (context 0))

)

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

---

;; ЕСЛИ аналих в предположении о правдивости персонажа

;;привёл к противоречию с другим «миром»,

;; ТО выполнить анализ, предполагая, что персонаж лжёт.

(defrule other-world

?W

(modify ?W (scope falsity) (task check))

)

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

---

;; ОБРАБОТКА ПРОТИВОРЕЧИЙ

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

---

;; ЕСЛИ обнаруживается противоречие между предположением

;; и производными от него фактами в пределах одного и

;; того же мира и в одном и том же контексте,

;; ТО зафиксировать противоречия и удалить

;; противоречивые утверждения (объект claim)

;; из базы фактов.

(defrule contradiction

(declare (salience 100))

?W

(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))

Страницы: 1, 2, 3, 4, 5, 6, 7, 8