=>
(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, созданные
;; после объекта М, удалены,
;; ТО повторно сформировать объект М,