Пример 9.13. Правила system-banner и print-repair

(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 выведет сообщение об ошибке.