Пример 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 воспринимает только символы английского алфавита, поэтому комментарии, приведенные в листинге, необходимо опустить.