|
|
|
А.4.7.
Полный листинг программы
Ниже приведен
полный листинг CLIPS-программы, которая обеспечивает обработку составных утверждений
и метавысказывании.
Эта программа
предназначена для разрешения головоломок о правдолюбцах и лжецах. Программа
анализирует наличие логических противоречий и отыскивает первую непротиворечивую
интерпретацию.
Программа
может обрабатывать конъюнктивные и дизъюнктивные составные утверждения. Программа
может решать задачи с множеством высказываний и метавысказываниями.
TEMPLATES
Объект CLAIM имеет следующие поля: CONTENT - содержимое утверждения, например, Т А ... означает, что А является правдолюбцем; F A ... означает, что А является лжецом; OR Т A F В ... означает, что А является правдолюбцем или В является лжецом, и т.д. 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 - удаляет все утверждения, созданные
;;в противоречивом "мире" ;
;;BАСК - откат в точку возврата;
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))
)
;;
ФУНКЦИЙ
;;
Изменяет область определения предиката с Т на 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))) )
ЕСЛИ объект
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 " и HE " ?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 notl
(declare
(salience 5))
?F
<- (claim (content NOT Т ?P)) =>
(modify
?F (content F ?P)) )
;; ЕСЛИ некто не лжец,
;;
ТО он правдолюбец, (defrule not2
(declare
(salience 5))
?F
<- (claim (content NOT F ?P)) =>
(modify
?F (content Т ?Р)) )
;;---------------------
;; Распространение отрицания на дизъюнкцию,
(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-and
(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) (context ?L))
;;
ОБРАБОТКА ДИЗЪЮНКТИВНЫХ УТВЕРЖДЕНИЙ
)
;;
ЕСЛИ мы имеем дело с дизъюнктивным утверждением,
;;
т.е. context = 0,
;;
ТО сначала проанализировать левый дизъюнкт.
;;
ПРИМЕЧАНИЕ. Устанавливается значение 1 как в поле
;;
context объекта world, так и в поле context нового
;
; объекта claim.
(defrule
left-disjunct
?W <- (world (tag ?N) (task check)
(scope
?V) (context 0))
(claim
(content OR ?P ?X ?Q ?Y) (reason ?N)
(scope
?V) (context 0» =>
(assert (claim (content ?P ?X)
(reason
?N) (scope ?V) (context 1)))
(modify
?W (context 1))
)
;; ЕСЛИ при анализе левого дизъюнкта обнаружено
;;
противоречие ,
;; ТО проанализировать правый дизъюнкт.
(defrule
right-disjunct
(declare
(salience 10))
?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 worlds " ?N "|" ?M
;; "МЕЖМИРОВОЕ ПРОТИВОРЕЧИЕ: " ?F ?X " противоречит
;;
?G ?X " в мирах " ?N "|" ?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 ?6 ?F)) ?X) (reason ?M&:(< ?M ?N))) =>
(printout
t crlf
"TRANSWORLD CONTRADICTION: " ?F ?X "
versus
?G ?X " in worlds " ?N "|" ?M
;; "МЕЖМИРОВОЕ ПРОТИВОРЕЧИЕ: " ?F ?X " противоречит
;;
?G ?X " в мирах " ?N "|" ?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 "|" ?M
;; "МЕЖМИРОВОЕ ПРОТИВОРЕЧИЕ: " ?F ?X "
противоречит
" ;; ?G ?X " в мирах " ?N "|" ?M
t
crlf) (retract ?S) (modify ?W (task contra) (prior ?U))
;;ОПЕРАЦИИ
УДАЛЕНИЯ
;;
Удаление дизъюнкта, (defrule clean-context
(declare
(salience 50)) (world
(tag
?N)
(task
?T&:(or (eg ?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 ?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))
)
;;ПЕРЕХОД К АНАЛИЗУ СЛЕДУЮЩЕГО "МИРА" И
;;ВЫВОД
ОТЧЕТА О РЕЗУЛЬТАТАХ
;;Переход к анализу следующего "мира",
;;ЕСЛИ никакие другие правила не ожидают активизации,
;;ТО анализ текущего "мира" завершен и
;;можно приступить к формированию нового "мира",
;;если имеются необработанные высказывания.
;;ПРИМЕЧАНИЕ. Это правило имеет приоритет,
;;более низкий, чем все прочие правила,
;;исключая правило вывода результатов,
(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-results
(declare (salience -40)) (not (world (task contra)))
(not (statement (reason 0) (done 0)))
(statement (tag ?N) (done ?MS~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 (eg ?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 позволяет реализовать многие из описанных в данной книге технологий,
в частности:
На примере этой программы вы также могли убедиться в том, что несмотря на модульную структуру, расширение ее функциональных возможностей сопряжено с определенной модификацией ранее разработанных модулей (правил), которые должны учитывать изменения, вносимые в структуру данных.
|
|
|
 |
|||||||||||||||||||||||||
|
|
|||||||||||||||||||||||||
|
|
|
|
|
||||||||||||||||||||||
|
|
|
|
|
|
|
|
|
|
|
|
|
||||||||||||||