Пример 14.16. Правило print-header(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)) ) Приведенное выше правило print-header предназначено для вывода на экран заголовка таблицы истинности. Затем правило добавляет в систему факт print-results, активизирующий правило print-result. Заголовок содержит список всех источников системы и список индикаторов, разделенных вертикальной чертой. Кроме того, для большего удобства восприятия правило отделяет заголовок таблицы от ее содержания дополнительной строкой. Это правило имеет более низкий приоритет, чем остальные правила экспертной системы, и не имеет явных условных элементов. Поэтому выполняется только после завершения перебора всевозможных комбинаций входных сигналов логической схемы. Пример 14.17. Правило print-result (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 воспринимает только символы английского алфавита, поэтому комментарии, приведенные в листинге, необходимо опустить.
|
