Национальный исследовательский институт

Московский Энергетический Институт (Технический Университет)

Институт автоматики и вычислительной техники

Кафедра Прикладной математики

Лабораторная работа №3

по дисциплине «Экспертные системы»

тема: «Разработка экспертной системы с использованием программной среды CLIPS»

Выполнил:

Машеров Д.Е.

.

Москва

2012 г.

Постановка задачи

Разработать экспертную систему с использованием программы CLIPS.

Описание предметной области

Разрабатывается ЭС «Категоризация бриллиантов», которая позволяет выполнить категоризацию бриллиантов. Предметная обасть формализуется с помощью дерева целей, изображенном на Рис.1, дужкой помечена вершина «И», а отсутвием дужки – вершина «ИЛИ».

Описание работы ЭС

По дереву целей описаны переменные и правила, представленные в листинге.

Кэоффициенты уверенности объединяются по вероятностной схеме:

1. Объединение факторов уверенности для левой и правой частей правила

(a * b) / 100

1. Объединение факторов уверенности, полученных по нескольким правилам для одной переменной

a + b – (a * b) / 100

Рис.1. Дерево целей

Листинг

Ввод параметров

(defrule FAMOUS-input

(declare (salience 1000))

(initial-fact) =>

(printout t "Byl li u kamnja izvestnyj vladelec?(1 - da, 2 - net)? ")

(bind ?string (read))

(if (= ?string 1) then (assert(FAMOUS TRUE))

else (assert(FAMOUS FALSE))))

(defrule UNUSUAL-input

(declare (salience 900))

(initial-fact)=>

(printout t "Est' li neobychnaja istorija u kamnja?(1 - da, 2 - net)")

(bind ?string (read))

(if (= ?string 1) then (assert(UNUSUAL TRUE))

else (assert(UNUSUAL FALSE))))

(defrule WEIGHT-input

(initial-fact) =>

(printout t "Vvedite ves v karatah ")

(assert(WEIGHT (read))))

(defrule SYMMETRY-input

(initial-fact) =>

(printout t "Brilliant simmetrichen?(1 - da, 2 - net)")

(bind ?string (read))

(if (= ?string 1) then (assert(SYMMETRY TRUE))

else (assert(SYMMETRY FALSE))))

(defrule POLISH-input

(initial-fact) =>

(printout t "Est' li u brillianta negladkie storony?(1 - da, 2 - net)")

(bind ?string (read))

(if (= ?string 1) then (assert(POLISH FALSE))

else (assert(POLISH TRUE))))

(defrule PROPORT-input

(initial-fact) =>

(printout t "Vvedite otnoshenie rundisty(pojasa) k vysote kamnja v procentah ")

(assert(PROPORT (read))))

(defrule CRACKS-input

(initial-fact) =>

(printout t "Imejutsja li treshhiny? (1 - da, 2 - net)")

(bind ?string (read))

(if (= ?string 1) then (assert(CRACKS TRUE))

else (assert(CRACKS FALSE))))

(defrule DOTS-input

(initial-fact) =>

(printout t "Imejutsja li temnye tochki na poverhnosti? (1 - da, 2 - net)")

(bind ?string (read))

(if (= ?string 1) then (assert(DOTS TRUE))

else (assert(DOTS FALSE))))

(defrule COLOUR-input

(initial-fact) =>

(printout t "Ukazhite cvet (1 - bescvetnyj, 2 - zheltyj, 3 - cvetnoj)")

(assert(COLOUR (read))))

(defrule SCIN-input

(initial-fact) =>

(printout t "Imeejutsja li vspyshki sveta pri vrashhenii kamnja?(1 - da, 2 - net)")

(bind ?string (read))

(if (= ?string 1) then (assert(SCIN TRUE))

else (assert(SCIN FALSE))))

(defrule DISP-input

(initial-fact) =>

(printout t "Imeejutsja li cvetovye bliki?(1 - da, 2 - net)")

(bind ?string (read))

(if (= ?string 1) then (assert(DISP TRUE))

else (assert(DISP FALSE))))

Функция объединения правил

(deffunction combinef (?cf)

(if (not ?*firstf*) then (bind ?*firstf* TRUE) (bind ?*catf* ?cf)

else

(bind ?*catf* (- (+ ?*catf* ?cf) (/ (* ?*catf* ?cf) 100)))))

(deffunction combine (?cf)

(if (not ?*first*) then (bind ?*first* TRUE) (bind ?*cat* ?cf)

else

(if (< ?cf 0)

then (combinef (- 0 ?cf))

else (bind ?*cat* (- (+ ?*cat* ?cf) (/ (* ?*cat* ?cf) 100))))))

(defglobal ?*cat* = 100)

(defglobal ?*catf* = 100)

Правила для вычисления коэффициента уверенности целевой переменной

(defrule R1

(PROPORT ?val)

(and (SYMMETRY TRUE) (POLISH TRUE) (test (< ?val 50)))

=>

(printout t "--Esli brilliant simmetrichen, imeet gladkie storony i pravil'nye proporcii rundisty, to kachestvo ogranki horoshee" crlf)

(assert (CUTQUAL TRUE)))

(defrule R2

(or (SYMMETRY FALSE))

=>

(printout t "--Esli brilliant nesimmetrichen, to kachestvo ogranki neudovletvoritel'noe" crlf)

(assert (CUTQUAL FALSE)))

(defrule R3

(or (POLISH FALSE))

=>

(printout t "--Esli brilliant nesimmetrichen, to kachestvo ogranki neudovletvoritel'noe" crlf)

(assert (CUTQUAL FALSE)))

(defrule R4

(PROPORT ?val)

(test (>= ?val 50))

=>

(printout t "--Esli u brillianta nepravil'nye proporcii rundisty, to kachestvo ogranki neudovletvoritel'noe" crlf)

(assert (CUTQUAL FALSE)))

(defrule R5

(and (SCIN FALSE) (DISP FALSE))

=>

(printout t "--Esli scinciljacija i dispersija ne projavljajutsja, to igra brillianta neudovletvoritel'na" crlf)

(assert (PLAY FALSE)))

(defrule R6

(SCIN TRUE)

=>

(printout t "--Esli projavljaetsja scinciljacija, to igra brillianta schitaetsja horoshej" crlf)

(assert (PLAY TRUE)))

(defrule R7

(DISP TRUE)

=>

(printout t "--Esli projavljaetsja dispersija, to igra brillianta schitaetsja horoshej" crlf)

(assert (PLAY TRUE)))

(defrule R8

(FAMOUS TRUE)

=>

(printout t "--Esli u brillianta imetsja neobychnaja istorija, to brilliant imeet kollekcionnuju cennost'" crlf)

(assert (COLLECT TRUE)))

(defrule R9

(UNUSUAL TRUE)

=>

(printout t "--Esli u brillianta byl izvestnyj vladelec, to brilliant imeet kollekcionnuju cennost' " crlf)

(assert (COLLECT TRUE)))

(defrule R10

(and (FAMOUS FALSE) (UNUSUAL FALSE))

=>

(printout t "--Esli u brillianta ne bylo ni izvestnogo vladelec, ni neobychnoj istorii, to u brillianta net kollekcionnoj cennosti" crlf)

(assert (COLLECT FALSE)))

(defrule R11

(CUTQUAL TRUE)

=>

(printout t "--Esli kachestvo ogranki horoshee, to brilliant otnositsja k vysokoj kategorii" crlf)

(combine 70))

(defrule R12

(CUTQUAL FALSE)

=>

(printout t "--Esli kachestvo ogranki plohoe, to brilliant otnositsja k nizkoj kategorii" crlf)

(combine -70))

(defrule R13

(COLOUR ?val)

(test (= ?val 1))

=>

(printout t "--Esli brilliant bescvetnyj, to brilliant otnositsja k vysokoj kategorii" crlf)

(combine 40))

(defrule R14

(COLOUR ?val)

(test (= ?val 2))

=>

(printout t "--Esli brilliant imeet zheltovatyj cvet, to brilliant otnositsja k nizkoj kategori" crlf)

(combine -40))

(defrule R15

(COLOUR ?val)

(test (= ?val 3))

=>

(printout t "--Esli brilliant imeet otlichnyj ot zheltogo cvet, to brilliant otnositsja k vysokoj kategorii" crlf)

(combine 40))

(defrule R16

(and (CRACKS FALSE) (DOTS FALSE))

=>

(printout t "--Esli otsutstvujut treshhiny i temnye tochki, to chistota brillanta horoshaja" crlf)

(assert (PURITY TRUE)))

(defrule R17

(CRACKS TRUE)

=>

(printout t "--Esli imeejutsja treshhiny, to chistota brillanta neudovletvoritel'naja" crlf)

(assert (PURITY FALSE)))

(defrule R18

(DOTS TRUE)

=>

(printout t "--Esli imeejutsja temnye tochki, to chistota brillanta neudovletvoritel'naja" crlf)

(assert (PURITY FALSE)))

(defrule R19

(PURITY TRUE)

=>

(printout t "--Esli chistota brillanta horoshaja, to brilliant otnositsja k vysokoj kategorii" crlf)

(combine 50))

(defrule R20

(PURITY FALSE)

=>

(printout t "--Esli chistota brillanta neudovletvoritel'naja, to brilliant otnositsja k nizkoj kategorii" crlf)

(combine -50))

(defrule R21

(PLAY TRUE)

=>

(printout t "--Esli igra brillianta horoshaja, to brilliant otnositsja k vysokoj kategorii" crlf)

(assert (end TRUE))

(combine 30))

(defrule R22

(PLAY FALSE)

=>

(printout t "--Esli igra brillianta plohaya, to brilliant otnositsja k nizkoj kategorii" crlf)

(assert (end TRUE))

(combine -30))

(defrule R23

(COLLECT TRUE)

=>

(printout t "--Esli brilliant imeet kollekcionnuju cennost', to brilliant otnositsja k vysokoj kategorii" crlf)

(assert (end TRUE))

(assert (CATEG cf 100)))

(defrule R24

(WEIGHT ?val)

(test (<= ?val 1))

=>

(printout t "--Esli brilliant imeet nebol'shoj ves, to brilliant otnositsja k nizkoj kategorii" crlf)

(combine -70))

(defrule R25

(WEIGHT ?val)

(and (test (> ?val 1)) (test (<= ?val 3)))

=>

(printout t "--Esli brilliant imeet nebol'shoj ves, to brilliant otnositsja k nizkoj kategorii" crlf)

(combine 70))

(defrule R26

(WEIGHT ?val)

(test (> ?val 3))

=>

(printout t "--Esli brilliant imeet nebol'shoj ves, to brilliant otnositsja k nizkoj kategorii" crlf)

(combine 75))

Примеры работы

1. Хороший случай

Результат:

Использованные правила для вычисления целевой переменной:

R25 cf 70

R11 cf 70

R19 cf 50

R13 cf 40

R21 cf 30

Расчет коэффицентов:

cf_true = (70*100) / 100 + (70*100) / 100 – (70*70)/100 +

50 – (91 * 50) /100 +

40 - (95.5 * 40) +

30 – (97.3*30) /100 = 98.11

1. Плохой случай

Результат:

Использованные правила для вычисления целевой переменной:

R25 cf70

R12 cf70

R20 cf -50

R14 cf- 40

R22 cf -30

Расчет коэффицентов:

cf_true (-)= (70*100) / 100 + (50*100) / 100 – (70*50)/100 +

40 – (85 * 40)/100 +

30 – (30 * 91)/100 = 93.7

cf_true (+)= (70*100/100)

cf_true = cf_true (+) * (100 - cf_true (-)) / 100 =70 * 6.3 /100 = 4.41

1 – cf_true ≈ 95.59

1. Средний случай

Результат:

Использованные правила для вычисления целевой переменной:

R25 cf 70

R19 cf 70

R15 cf 50

R12 cf -70

R22 cf -30

Расчет коэффицентов:

cf_true (-)= (70*100) / 100 + (30*100) / 100 – (70*50)/100 = 65

cf_true (+)= (70*100)/100 + (50*100)/100 – (70*50)/100 +

40 – (85*40)/100 = 91

cf_true = cf_true (+) * (100 - cf_true (-)) / 100 =85* 35 /100 = 29.75

1 – cf_true ≈81

Заключение

Была спроектирована экспертная система «Категоризация бриллиантов» при помощи инструментального средства CLIPS.