2015-03-22
637
(defrule system-banner ""
(declare (salience 10))
=>
(printout t crlf crlf)
(printout t "**********************************" crlf)
(printout t "* The Engine Diagnosis Expert System *" crlf)
(printout t "**********************************" crlf)
(printout t crlf crlf)
)
(defrule print-repair ""
(declare (salience 10))
(repair?item)
=>
(printout t crlf crlf)
(printout t "Suggested Repair:")
(printout t crlf crlf)
(format t " %s%n%n%n"?item)
)
Листинг программы
В данном разделе приведен полный листинг программы с подробными комментариями. Если у вас еще не сложилась целостная картина о том, как работает наша экспертная система, из каких частей она состоит, внимательно изучите приведенный ниже код.
Пример 9.14. Полный листинг программы
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
; Пример экспертной системы на языке CLIPS
;
; Приведенная ниже экспертная система способна
; диагностировать некоторые неисправности автомобиля и
; предоставлять пользователю рекомендации по устранению
; неисправности.
;
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
; Вспомогательные функции
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - - - - - - -
; Функция ask-question задает пользователю вопрос, полученный
; в переменной?question, и получает от пользователя ответ,
; принадлежащий списку допустимых ответов, заданному в $?allowed-values
(deffunction ask-question (?question $?allowed-values)
(printout t?question)
(bind?answer (read))
(if (lexemep?answer)
then
(bind?answer (lowcase?answer)))
(while (not (member?answer?allowed-values)) do
(printout t?question)
(bind?answer (read))
(if (lexemep?answer)
then
(bind?answer (lowcase?answer))))
?answer
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Функция yes-or-no-p задает пользователю вопрос, полученный
; в переменной?question, и получает от пользователя ответ yes(у) или
; по(n). В случае положительного ответа функция возвращает значение TRUE,
; иначе — FALSE
(deffunction yes-or-no-p (?question)
(bind?response (ask-question?question yes no у n))
(if (or (eq?response yes) (eq?response y))
then
TRUE
else
FALSE)
)
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
; Диагностические правила
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Правило determine-engine-state определяет текущее состояние двигателя
; машины по ответам, получаемым от пользователя. Двигатель может
; находиться в одном из трех состояний: работать нормально
; (working-state engine normal), работать неудовлетворительно
; (working-state engine unsatisfactory) и не заводиться
; (working-state engine;does-not-start) (см. правило 1).
(defrule determine-engine-state ""
(not (working-state engine?))
(not (repair?))
=>
(if (yes-or-no-p "Does the engine start (yes/no)? ")
then
(if (yes-or-no-p "Does the engine run normally (yes/no)? ")
then
(assert (working-state engine normal))
else
(assert (working-state engine unsatisfactory)))
else
(assert (working-state engine does-not-start)))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Правило determine-rotation-state определяет состояние вращения двигателя по ответу,
; получаемому от пользователя. Двигатель может вращаться (rotation-state engine rotates)
; или не вращаться (spark-state engine does-not-spark) (см. правило 4).
; Кроме того, правило делает предположение о наличии плохой искры
; или ее отсутствии в системе зажигания
(defrule determine-rotation-state ""
(working-state engine does-not-start)
(not (rotation-state engine?))
(not (repair?))
=>
(if (yes-or-no-p "Does the engine rotate (yes/no)? ")
then
; Двигатель вращается
(assert (rotation-state engine rotates))
; Плохая искра
(assert (spark-state engine irregular-spark))
else
; Двигатель не вращается
(assert (rotation-state engine does-not-rotate))
; Нет искры
(assert (spark-state engine does-not-spark)))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Правило determine-gas-level по ответу пользователя определяет
; наличие топлива в баке. В случае если топлива нет, пользователю
; выдается рекомендация по ремонту — машину необходимо заправить
; (repair "Add gas.") (см. правило 5). При появлении соответствующей
; рекомендации выполнение диагностических правил прекращается.
(defrule determine-gas-level ""
(working-state engine does-not-start)
(rotation-state engine rotates)
(not (repair?))
=>
(if (not (yes-or-no-p "Does the tank have any gas in it (yes/no)? "))
then
; Машину необходимо заправить
(assert (repair "Add gas.")))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Правило determine-battery-state по ответу пользователя определяет,
; заряжен ли аккумулятор. В случае если это не так, пользователю
; выдается рекомендация по ремонту — Зарядите аккумулятор (repair
; "Charge the battery.") (см. правило 6).
; Кроме того, правило добавляет факт, описывающий состояние аккумулятора.
; Выполнение диагностических правил прекращается
(defrule determine-battery-state ""
(rotation-state engine does-not-rotate}
; Состояние аккумулятора еще не определено
(not (charge-state battery?))
(not (repair?))
=>
(if (yes-or-no-p "Is the battery charged (yes/no)? ")
then
; Аккумулятор заряжен
(assert (charge-state battery charged))
else
; Зарядите аккумулятор
(assert (repair "Charge the battery."))
; Аккумулятор разряжен
(assert (charge-state battery dead)))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Правило determine-low-output определяет, развивает ли двигатель
; нормальную выходную мощность или нет и добавляет в систему факт,
; описывающий эту характеристику (см. правило 12).
(defrule determine-low-output ""
(working-state engine unsatisfactory)
; Мощность работы двигателя еще не определена
(not (symptom engine low-output | not-low-output))
(not (repair?))
=>
(if (yes-or-no-p "Is the output of the engine low (yes/no)? ")
then
; Низкая выходная мощность двигателя
(assert (symptom engine low-output))
else
; Нормальная выходная мощность двигателя
(assert (symptom engine not-low-output)))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Правило determine-point-surface-state определяет по ответу
; пользователя состояние контактов (см. правила 7, 12). Контакты могут
; находиться в одном из трех состояний: чистые, опаленные и
; загрязненные. В двух последних случаях пользователю выдаются
; соответствующие рекомендации.
; Выполнение диагностических правил прекращается.
(defrule determine-point-surfасе-state ""
(or (and (working-state engine does-not-start);не заводится
(spark-state engine irregular-spark));и плохая искра
(symptom engine low-output));или низкая мощность
(not (repair?))
= >
(bind?response (ask-question "What is the surface state of the
points (normal /burned /contaminated)?"
normal burned contaminated))
(if (eq?response burned)
then
; Контакты опалены — замените контакты
(assert (repair "Replace the points."))
else
(if (eq?response contaminated)
then
; Контакты загрязнены - почистите их
(assert (repair "Clean the points."))))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Правило determine-conductivity-test по ответу пользователя определяет,
; пропускает ли ток катушка зажигания. Если нет, то ее следует заменить.
; Если пропускает, то причина неисправности — распределительные провода.
; Для нормальной работы правила необходимо убедиться, что аккумулятор
; заряжен и искры нет (см. правило 8)
; Выполнение диагностических правил прекращается.
(defrule determine-conductivity-test ""
(working-state engine does-not-start)
(spark-state engine does-not-spark);нет искры
(charge-state battery charged);аккумулятор заряжен
(not (repair?))
=>
(if (yes-or-no-p "Is the conductivity test for the ignition coil positive (yes/no)? ")
then
; Замените распределительные провода
(assert (repair "Repair the distributor lead wire."))
else
; Замените катушку зажигания
(assert (repair "Replace the ignition coil.")))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Правило determine-sluggishness спрашивает пользователя, не ведет ли
; себя машина инертно (не сразу реагирует на подачу топлива).
; Если такой факт обнаружен, то необходимо прочистить
; топливную систему (см. правило 9) и выполнение диагностических правил
; прекращается.
(defrule determine-sluggishness ""
(working-state engine unsatisfactory)
(not (repair?))
=>
(if (yes-or-no-p "Is the engine sluggish (yes/no)? ")
then
; Прочистите систему подачи топлива
(assert (repair "Clean the fuel line.")))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Правило determine-misfiring узнает — нет ли перебоев с зажиганием.
; Если это так, то необходимо отрегулировать зазоры между контактами
; (см. правило 10).
; Выполнение диагностических правил прекращается.
(defrule determine-misfiring ""
(working-state engine unsatisfactory)
(not (repair?))
=>
(if (yes-or-no-p "Does the engine misfire (yes/no)? ")
then
; Отрегулируйте зазоры между контактами
(assert (repair "Point gap adjustment."))
; Плохая искра
(assert (spark-state engine irregular-spark)))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Правило determine-knocking узнает — не стучит ли двигатель.
; Если это так, то необходимо отрегулировать зажигание (см. правило 11).
; Выполнение диагностических правил прекращается.
(defrule determine-knocking ""
(working-state engine unsatisfactory)
(not (repair?))
=>
(if (yes-or-no-p "Does the engine knock (yes/no)? ")
then
; Отрегулируйте положение зажигания
(assert (repair "Timing adjustment.")))
)
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
; Правила, определяющие состояние некоторых подсистем автомобиля
; по характерным состояниям двигателя
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Правило normal-engine-state-conclusions реализует правило 2
(defrule normal-engine-state-conclusions ""
(declare (salience 10))
; Если двигатель работает неудовлетворительно
(working-state engine normal)
=>
; то
(assert (repair "No repair needed.")); ремонт не нужен
(assert (spark-state engine normal)); зажигание в норме
(assert (charge-state battery charged)); аккумулятор заряжен
(assert (rotation-state engine rotates)); двигатель вращается
)
; Правило unsatisfactory-engine-state-conclusions реализует правило 3
(defrule unsatisfactory-engine-state-conclusions ""
(declare (salience 10))
; Если двигатель работает нормально
(working-state engine unsatisfactory)
=>
; то
(assert (charge-state battery charged)); аккумулятор заряжен
(assert (rotation-state engine rotates)); двигатель вращается
)
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =; Запуск и завершение
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Правило no-repairs запускается в случае, если ни одно
; из диагностических правил не способно определить неисправность.
; Правило корректно прерывает выполнение экспертной системы и предлагает
; пройти более тщательную проверку (см. правило 13).
(defrule no-repairs ""
(declare (salience -10))
(not (repair?))
=>
(assert (repair "Take your car to a mechanic."))
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Правило print-repair выводит на экран диагностическое сообщение
; по устранению найденной неисправности,
(defrule print-repair ""
(declare (salience 10))
(repair?item)
=>
(printout t crlf crlf)
(printout t "Suggested Repair:")
(printout t crlf crlf)
(format t " %s%n%n%n"?item)
)
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; Правило system-banner выводит на экран название экспертной системы
; при каждом новом запуске.
(defrule system-banner " каждом новом запуске."
(declare (salience 10))
=>; каждом новом запуске.
(printout t crlf crlf)
(printout t "********************************************" crlf)
(printout t "* The Engine Diagnosis Expert System *" crlf)
(printout t "**********************************" crlf)
(printout t crlf crlf)
)
Помните, что среда CLIPS (по крайней мере, последняя версия 6.20) воспринимает только символы английского алфавита. Все комментарии в приведенном листинге даны на русском языке для наглядности, однако при вводе программы в таком виде CLIPS выведет сообщение об ошибке.
