2015-03-22
577
(defrule print-result
(print-results)
?f <- (result $?input?response)
(not (result $?input-2?response-2&:
(< (str-compare?response-2?response) 0)))
=>
(retract?f)
(while (neq?input (create$)) do
(printout t " " (nth 1?input) " ")
(bind?input (rest$?input)))
(printout t " | ")
(bind?response (str-explode?response))
(while (neq?response (create$)) do
(printout t " " (nth 1?response) " ")
(bind?response (rest$?response)))
(printout t crlf)
)
Правило print-result выводит на экран оптимизированную таблицу истинности, сортируя при этом ее строки.
Листинг программы
Разработку экспертной системы CIOS можно считать завершенной. Данный раздел содержит полный листинг программы с подробными комментариями. Если у вас еще не сложилась целостная картина, как работает экспертная система CIOS, из каких частей она состоит, внимательно изучите приведенный код.
Пример 14.18. Полный листинг программы
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
; Пример экспертной системы на языке CLIPS
;
; Приведенная ниже экспертная система способна находить
; и оптимизировать таблицы истинности заданных логических схем.
;
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|
|
; Необходимые классы
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Класс COMPONENT является суперклассом для всех классов логических элементов
(defclass COMPONENT
(is-a USER)
(slot ID# (create-accessor write))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Класс NO-OUTPUT реализует логику работы элемента без логических выходов
(defclass NO-OUTPUT
(is-a USER)
(slot number-of-outputs (access read-only)
(default 0)
(create-accessor read))
)
; Предварительное объявление обработчика, осуществляющего обработку полученного сигнала
(defmessage-handler NO-OUTPUT compute-output ())
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Класс ONE-OUTPUT реализует логику работы элемента с одним логическим выходом
(defclass ONE-OUTPUT
(is-a NO-OUTPUT)
(slot number-of-outputs (access read-only)
(default 1)
(create-accessor read))
; значение выхода
(slot output-1 (default UNDEFINED)
(create-accessor write))
; название элемента, с которым связан выход
(slot output-1-link (default GROUND)
(create-accessor write))
; номер входа, с которым связан выход
(slot output-1-link-pin (default 1)
(create-accessor write))
)
; Обработчик для передачи обработанного сигнала на вход следующего элемента
(defmessage-handler ONE-OUTPUT put-output-1 after (?value)
(send?self:output-1-link
(sym-cat put-input-?self:output-l-link-pin)
?value)
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Класс TWO-OUTPUT реализует логику работы элемента с двумя логическими выходами
(defclass TWO-OUTPUT
(is-a ONE-OUTPUT)
(slot number-of-outputs (access read-only)
(default 2)
(create-accessor read))
; значение выхода
(slot output-2 (default UNDEFINED)
(create-accessor write))
; название элемента, с которым связан выход
(slot output-2-link (default GROUND)
|
|
|
(create-accessor write))
; номер входа, с которым связан выход
(slot output-2-link-pin (default 1)
(create-accessor write))
)
; Обработчик для передачи обработанного сигнала на вход следующего элемента
(defmessage-handler TWO-OUTPUT put-output-2 after (?value)
(send?self: output-2-link
(sym-cat put-input-?self: output-2-link-pin)
?value)
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Класс NO-INPUT реализует логику работы элемента без логических входов
(defclass NO-INPUT
(is-a USER)
(slot number-of-inputs (access read-only)
(default 0)
(create-accessor read))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Класс ONE-INPUT реализует логику работы элемента с одним логическим входом
(defclass ONE-INPUT
(is-a NO- INPUT)
(slot number-of-inputs (access read-only)
(default 1 )
(create-accessor read))
; значение входа
(slot input-1 (default UNDEFINED)
(visibility public)
(create-accessor read-write))
; название элемента, с которым связан вход
(slot input-1-link (default GROUND)
(create-accessor write))
;номер выхода, с которым связан вход
(slot input-1-link-pin (default 1)
(create-accessor write)))
; Обработчик, активизирующий процесс вычисления результата работы схемы
; после изменения данного входа
(defmessage-handler ONE-INPUT put-input-1 after (?value)
(send?self compute-output)
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Класс TWO-INPUT реализует логику работы элемента с двумя логическими входами
(defclass TWO-INPUT
(is-a ONE-INPUT)
(slot number-of-inputs (access read-only)
(default 2}
(create-accessor read))
; значение входа
(slot input-2 (default UNDEFINED)
(visibility public)
(create-accessor write))
; название элемента, с которым связан вход
(slot input-2-link (default GROUND)
(create-accessor write))
; номер выхода, с которым связан вход
(slot input-2-link-pin (default 1)
(create-accessor write))
)
; Обработчик, активизирующий процесс вычисления результата работы схемы
; после изменения данного входа
(defmessage-handler TWO-INPUT put-input-2 after (?value)
(send?self compute-output)
)
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
; Классы, реализующие логические элементы
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Класс, реализующий логику работы элемента SOURCE, имеет один выход и не имеет входов
(defclass SOURCE
(is-a NO-INPUT ONE-OUTPUT COMPONENT)
(role concrete)
(slot output-1 (default UNDEFINED)
(create-accessor write))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Класс, реализующий логику работы элемента LED, имеет один вход и не имеет выходов
(defclass LED
(is-a ONE-INPUT NO-OUTPUT COMPONENT)
(role concrete)
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Класс, реализующий логику работы элемента NOT, имеет один вход и один выход
(defclass NOT-GATE
(is-a ONE-INPUT ONE-OUTPUT COMPONENT)
(role concrete)
)
; Функция, вычисляющая значение элемента NOT в зависимости от полученного аргумента
(deffunctiori not# (?x) (- 1?х))
; Обработчик, выполняющий вычисления элемента NOT при изменении входных сигналов
(defmessage-handler NOT-GATE compute-output ()
(if (integerp?self:input-1) then
(send?self put-output-1 (not#?self:input-1)))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Класс, реализующий логику работы элемента AND, имеет два входа и один выход
(defclass AND-GATE
(is-a TWO-INPUT ONE-OUTPUT COMPONENT)
(role concrete)
)
; Функция, вычисляющая значение элемента AND в зависимости от полученного аргумента (deffunction and! (?x?y)
(if (and (! =?х 0) (!=?у 0)) then 1 else 0))
; Обработчик, выполняющий вычисления элемента AND при изменении входных сигналов (defmessage-handler AND-GATE compute-output ()
(if (and (integerp?self:input-1)
(integerp?self:input-2)) then
(send?self put-output-1
(and#?self:input-1?self:input-2)))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Класс, реализующий логику работы элемента OR, имеет два входа и один выход
(defclass OR-GATE
(is-a TWO- INPUT ONE-OUTPUT COMPONENT)
(role concrete)
)
; Функция, вычисляющая значение элемента OR в зависимости от полученного аргумента
(deffunction or# (?x?y)
(if (or (!=?х 0) (I-?y 0)) then 1 else 0))
; Обработчик, выполняющий вычисления элемента OR при изменении входных сигналов
(defmessage-handler OR-GATE compute-output ()
(if (and (integerp?self: input-1)
(integerp?self: input-2)) then
|
|
|
(send?self put-output-1
(or#?self: input-1?self: input-2)))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Класс, реализующий логику работы элемента NAND, имеет два входа и один выход
(defclass NAND-GATE
(is-a TWO-INPUT ONE-OUTPUT COMPONENT)
(role concrete)
)
; Функция, вычисляющая значение элемента NAND в зависимости от полученного аргумента
(deffunction nand# (?x?y)
(if (not (and (!=?x 0) (!=?y 0») then 1 else 0))
; Обработчик, выполняющий вычисления элемента NAND при изменении входных сигналов
(defmessage-handler NAND-GATE compute-output ()
(if (and (integerp?self: input-1)
(integerp?self: input-2)) then
(send?self put-output-1
(nand#?self: input-1?self: input-2)))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Класс,реализующий логику работы элемента XOR, имеет два входа и один выход
(defclass XOR-GATE
(is-a TWO- INPUT ONE-OUTPUT COMPONENT)
(role concrete)
)
; Функция, вычисляющая значение элемента XOR в зависимости от полученного аргумента
(deffunction xor# (?x?y)
(if (or (and (=?x 1) (=?y 0))
(and (=?x 0} (=?y 1))) then 1 else 0))
; Обработчик, выполняющий вычисления элемента XOR при изменении входных сигналов
(defmessage-handler XOR-GATE compute-output (}
(if (and (integerp?self: input-1)
(integerp?self: input-2)) then
(send?self put-output-1
(xor#?self: input-1?self: input-2)))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Класс, реализующий логику работы элемента SPLITTER, имеет один вход и два выхода
(defclass SPLITTER
(is-a ONE-INPUT TWO-OUTPUT COMPONENT)
(role concrete)
)
; Обработчик, выполняющий вычисления элемента SPLITTER при изменении входных сигналов
(defmessage-handler SPLITTER compute-output ()
(if (integerp?self: input-1) then
(send?self put-output-1?self: input-1)
(send?self put-output-2?self: input-1))
)
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
; Методы родовой функции
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Предварительное объявление родовой функции
(defgeneric connect)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Соединение элемента, имеющего один выход, с элементом, имеющим один вход
(defmethod connect ((?out ONE-OUTPUT) (?in ONE-INPUT))
(send?out put-output-1-link?in)
(send?out put-output-1-link-pin 1)
(send?in put-input-1-link?out)
(send?in put-input-1-link-pin 1)
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
; Соединение элемента, имеющего один выход, с элементом, имеющим два входа
(defmethod connect ((?out ONE-OUTPUT) (?in TWO- INPUT) (?in-pin INTEGER))
(send?out put-output-1-link?in)
(send?out put-output-1-link-pin?in-pin)
(send?in (sym-cat put-input-?in-pin -link)?out)
(send?in (sym-cat put-input-?in-pin -link-pin) 1)
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Соединение элемента, имеющего два выхода, с элементом, имеющим один вход
(defmethod connect ((?out TWO-OUTPUT) (?out-pin INTEGER) (?in ONE-INPUT)
(send?out (sym-cat put-output-?out-pin -link)?in)
(send?out (sym-cat put-output-?out-pin -link-pin) 1)
(send?in put-input-1-link?out)
(send?in put-input-1-link-pin?out-pin)
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Соединение элемента, имеющего два выхода, с элементом, имеющим два входа
(defmethod connect ((?out TWO-OUTPUT) (?out-pin INTEGER)(?in TWO- INPUT) (?in-pin INTEGER))
(send?out (sym-cat put-output-?out-pin -link)?in)
(send?out (sym-cat put-output-?out-pin -link-pin)?in-pin)
(send?in (sym-cat put-input-?in-pin -link)?out)
(send?in (sym-cat put-input-?in-pin -link-pin)?out-pin)
)
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = == = = = = = = = = = = = = = = = =
; Глобальные переменные
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = == = = = = = = = = = = = = = = = =
(defglobal?*gray-code* = (create$); Переменная для хранения текущего кода Грея
?*sources* = (create$); Список источников текущей логической схемы
?*max-iterations* = 0); Максимальное число итераций для текущей логической схемы
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = == = = = = = = = = = = = = = = = =
; Вспомогательные функции
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = == = = = = = = = = = = = = = = = =
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Определяет номер сигнала, который необходимо изменить для получения
; следующего кода Грея
(deffunction change-which-bit (?x)
(bind?i 1)
(while (and (evenp?x) (!=?x 0)) do
(bind?x (div?x 2))
(bind?i (+?i 1))
)
?i
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; С помощью функции do-for-all-instances определяет обработанный сигнал с индикаторов
; логической схемы
(def function LED- response ()
(bind? response (create$))
(do-for-all-instances ((?led LED)) TRUE
(bind?response (create$?response
(send?led get-input-1))))
?response
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Предварительное объявление функции, необходимой для объединения элементов
; логической схемы
deffunction connect-circuit ())
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = == = = = = = = = = = = = = = = = =
; Правила
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = == = = = = = = = = = = = = = = = =
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Инициализация логической схемы и запуск системы
(defrule startup
=>
; инициализация текущей логической схемы
(connect-circuit)
; получение имен всех источников текущей логической схемы
(bind?*sources* (find-all-instances ((?х SOURCE)) TRUE))
; создает нулевой код Грея
(do-for-all-instances ((?x SOURCE)) TRUE
(bind?*gray-code* (create$?*gray-code* 0)))
; определение максимального числа итераций
(bind?*max-iterations* (round (** 2 (length?*sources*))
; обнуление количества сделанных итераций
(assert (current-iteration 0))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Запуск процесса перебора всевозможных входных сигналов текущей логической системы
(defrule compute-response-1st-time
; если это первая итерация, то
?f <- (current-iteration 0)
=>
; помещение во все источники нулевого сигнала
(do-for-all-instances ((?source SOURCE)) TRUE
(send?source put-output-1 0))
; получение результата работы логической схемы
(assert (result?*gray-code* =(str-implode (LED-response))))
; увеличение количества итераций на 1
(retract?f)
(assert (current-iteration 1))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Перебор всевозможных входных сигналов текущей логической системы
(defrule compute-response-other-times
; если это не первая итерация и количество итераций еще не превышено
?f <- (current-iteration?n&~0&:(<?n?*max-iterations*))
=>
; вычисление номера источника, сигнал которого нужно менять
(bind?pos (change-which-bit?n))
; получение следующего кода Грея
(bind?nv (- 1 (nth?pos?*gray-code*)))
(bind?*gray-code* (replace$?*gray-code*?pos?pos?nv))
; изменение сигнала на заданном источнике на противоположный
(send (nth?pos?*sources*) put-output-1?nv)
; получение результата работы логической схемы
(assert (result?*gray-code* =(str-implode (LED-response))))
; увеличение количества итераций на 1
(retract?f)
(assert (current-iteration = (+?n 1)))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Оптимизация таблицы истинности
(defrule merge-responses
; более высокий приоритет позволяет производить оптимизацию
; в процессе построения таблицы истинности
(declare (salience 10))
; если в текущей таблице есть две строки, которые можно объединить
?fl <- (result $?b?x $?e?response)
?f2 <- (result $?b ~?x $?e?response)
=>
; то удалить такие строки
(retract?fl?f2)
; и вставить обобщенную строку
(assert (result?b *?е?response))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Вывод заголовка таблицы истинности
(defrule print-header
; более низкий приоритет запрещает применение этого правила
; до окончания перебора всевозможных вариантов входных сигналов
(declare (salience -10))
=>
; вывод списка источников
(do-for-all-instances ((?x SOURCE)) TRUE
(format t " %3s " (sym-cat?x)))
; вывод разделительной линии
(printout t " | ")
; вывод списка индикаторов
(do-for-all-instances ((?x LED)) TRUE
(format t " %3s " (sym-cat?x)))
(format t "%n")
; вывод разделительной линии, отделяющей заголовок
(do-for-all-instances ((?x SOURCE)) TRUE
(printout t " ----- ")) (printout t "-+-")
(do-for-all-instances ((?x LED)) TRUE
(printout t " ----- "))
(format t "%n")
; запрос на печать таблицы истинности
(assert (print-results))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Вывод таблицы истинности
(defrule print-result
; если заголовок уже напечатан
(print-results)
; еще остались не выведенные строки
?f <- (result $?input?response)
; выбор наименьшей по порядку строки
(not (result $?input-2?response-2&:
(< (str-compare?response-2?response) 0)))
=>
; удаление выбранной строки
(retract?f)
; вывод выбранной строки
(while (neq?input (create$)) do
(printout t " " (nth 1? input) "
(bind?input (rest$? input)))
(printout t " | ")
(bind?response (str-explode?response))
(while (neq?response (create$)) do
(printout t " " (nth 1?response)
(bind?response (rest$?response)))
(printout t crlf)
)
Создайте файл cios.CLP, содержащий текст переведенной выше программы. Как уже не раз упоминалось, среда CLIPS воспринимает только символы английского алфавита, поэтому комментарии, приведенные в листинге, необходимо опустить.
