--- pl:miw:2009:miw09_xtt_clips [2009/08/25 13:41]
jsi08
+++ pl:miw:2009:miw09_xtt_clips [2019/06/27 15:50] (aktualna)
@@ Linia 1: / Linia 1: @@
+~~ODT~~
 ====== MIW 2009 XTT_CLIPS ======
   *Zrealizował: [[mfabia@student.agh.edu.pl|Maciej Fabia]] (4RI)
@@ Linia 9: / Linia 10: @@
 ====== Sprawozdanie ======
-===== Przykłady systemów ekspertowych w CLIPS =====
+===== 1. Przykłady systemów ekspertowych w CLIPS =====
 Aby uruchomić program w CLIPS, należy:
   - otworzyć plik z rozszerzeniem "clp",
@@ Linia 17: / Linia 18: @@
 Jeśli uruchamiamy program ponownie, musimy wyczyścić listę faktów poleceniem Execution->Reset.
-==== Prosty system wybierający metodę leczenia ====
+==== 1.1. Prosty system wybierający metodę leczenia ====
 === Przeznaczenie ===
@@ Linia 23: / Linia 24: @@
 odpowiedzi potrafi zdiagnozować grypę, odrę, alergię, oraz zaleca odpowiednią terapię.
+Program nie sprawdza poprawności udzielanych odpowiedzi. Temperaturę chorego należy podać w skali Fahrenheit'a.
 === Właściwości ===
@@ Linia 32: / Linia 34: @@
 Do liczby argumentów nie wliczałem deklaracji priorytetów.
+Po lewej stronie reguł (część wyrażająca warunek) wykorzystano następujące kostrukcje CLIPS-a:
+  - wzorce wymagające istnienia pewnego faktu,
+  - deklaracje priorytetów.
 Trzy reguły posiadają zmodyfikowany priorytet:
@@ Linia 38: / Linia 44: @@
   * "None" - obniżony priotytet. Sprawdza, czy zdiagnozowano chorobę. Jeśli nie, zaleca wizytę u lekarza. Do poprawnego działania musi zostać aktywowana na końcu.
-=== Kod programu===
+=== Kod programu ===
 <code>
 (defrule GetTemperature
@@ Linia 157: / Linia 163: @@
    =>
    (printout t "No diagnosis possible -- consult human expert" crlf))
+</code>
+==== 1.2. Automotive Expert System ====
+=== Przeznaczenie ===
+System diagnozuje rodzaj awarii samochodu.
+=== Właściwości ===
+Ten przykład jest bardziej złożony od poprzedniego. Program wykorzystuje dwie funkcje służące do
+zadawania pytań: //ask-question// wymaga, aby odpowiedź należała do określonego zbioru, natomiast
+//yes-or-no-p// jest zawężeniem poprzedniej - akceptuje odpowiedzi //yes// i //no//.
+System zawiera 14 reguł:
+  * 1 regułę bezagrumentową - banner wyświetlany zaraz po uruchomieniu,
+  * 3 reguły jednoargumentowe,
+  * 4 reguły dwuargumentowe,
+  * 4 reguły trójargumentowe,
+  * 2 reguły czteroargumentowe.
+Po lewej stronie reguł (część wyrażająca warunek) wykorzystano następujące kostrukcje CLIPS-a:
+  - wzorce wymagające instnienia pewnego faktu,
+  - wzorce wymagające nieistnienia pewnego faktu,
+  - połączenie przypadków **1** i **2** łącznikami logicznymi //and//, //or//,
+  - deklaracje priorytetów.
+Po prawej stronie (część wykonywana po spełnieniu warunku) wielokrotnie znalazły się istrukcje
+//if-then-else// w celu zadania dodatkowego pytania.
+W systemie zmodyfikowano priorytety reguł:
+  * podwyższony priorytet //normal-engine-state-conclusions// i //unsatisfactory-engine-state-conclusions// - zapewniają wstawienie faktów związanych ze stanem silnika przed dalszą pracą,
+  * podwyższony priorytet //system-banner// - wypisuje powitalny banner po uruchomieniu,
+  * podwyższony priorytet //print-repair// - wypisuje po zakończeniu diagnostyki, co musimy naprawić,
+  * obniżony priorytet //no-repairs// - informuje, że nie udało się zdiagnozować uszkodzenia.
+=== Kod programu ===
+<code>
+;;;======================================================
+;;;   Automotive Expert System
+;;;
+;;;     This expert system diagnoses some simple
+;;;     problems with a car.
+;;;
+;;;     CLIPS Version 6.0 Example
+;;;
+;;;     To execute, merely load, reset and run.
+;;;======================================================
+;;****************
+;;* DEFFUNCTIONS *
+;;****************
+(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)
+(deffunction yes-or-no-p (?question)
+   (bind ?response (ask-question ?question yes no y n))
+   (if (or (eq ?response yes) (eq ?response y))
+       then TRUE
+       else FALSE))
+;;;**********************
+;;;* ENGINE STATE RULES *
+;;;**********************
+(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)))
+(defrule unsatisfactory-engine-state-conclusions ""
+   (declare (salience 10))
+   (working-state engine unsatisfactory)
+   =>
+   (assert (charge-state battery charged))
+   (assert (rotation-state engine rotates)))
+;;;***************
+;;;* QUERY RULES *
+;;;***************
+(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))))
+(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))))
+(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."))))
+(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))))
+(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."))))
+(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))))
+(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."))))
+(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))))
+(defrule determine-point-surface-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.")))))
+(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."))))
+(defrule no-repairs ""
+  (declare (salience -10))
+  (not (repair ?))
+  =>
+  (assert (repair "Take your car to a mechanic.")))
+;;;****************************
+;;;* STARTUP AND REPAIR RULES *
+;;;****************************
+(defrule system-banner ""
+  (declare (salience 10))
+  =>
+  (printout t crlf crlf)
+  (printout t "The Engine Diagnosis Expert System")
+  (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))
+</code>
+==== 1.3. Animal Identification Expert System ====
+=== Przeznaczenie ===
+System zadaje pytania dotyczące pewnego, nie znanego mu zwierzęcia. Na podstawie udzielonych informacji
+podejmuje próbę jego identyfikacji.
+=== Wstęp ===
+Jest to najbardziej złożony przykład spośród prezentowanych. Używa specjalnego silnika symulującego
+wnioskowanie wsteczne (//backward chaining inference engine//) symulowanego za pomocą standardowego
+silnika CLIPS-a. Dzięki temu program posiada nieco inną postać - cała baza wiedzy dotycząca
+identyfikacji zwierzęcia (zarówno fakty, jak i reguły) jest w całości przedstawiona jako fakty, w
+formie narzuconej przez silnik. Uzyskano w ten sposób większą przejrzystość.
+Silnik wstecznego wnioskowania składa się z kilku wydzielonych reguł. Nadano mu ogólną formę, która
+umożliwia łatwe zastosowanie go w innym programie - wystarczy go przekopiować i dodać fakty w ustalonej
+konwencji.
+=== Opis silnika ===
+  * postać faktu: ''(variable ?variable ?value)''
+    * //?variable// - nazwa zmiennej,
+    * //?value// - jej wartość,
+  * pytanie o zmienną, gdy nie znamy jej wartości: ''(question ?variable ? ?text)''
+  * zmienna, której wartości szukamy: ''(goal is ?variable)''
+  * reguła z jednym warunkiem: ''(rule (if ?variable ? ?value) (then ?var2 ? ?value2))''
+  * reguła z dwoma warunkami: ''(rule (if ?variable ? ?value and $var2 ? ?value2) (then...))''
+  * nie ma możliwości użycia reguł z więcej niż dwoma warunkami,
+  * poprawne odpowiedzi (dotyczy wszystkich pytań): ''(legalanswers answer1 answer2 ...)''
+  * tekst //?text// powiadamiający o znalezieniu celu //?goal//: ''(answer ? ?text ?goal)''
+=== Właściwości systemu identyfikacji zwierząt ===
+System został zapisany w kowencji wprowadzonej przez używany silnik:
+  * cel: //type.animal//,
+  * dozwolone odpowiedzi na pytania: //yes//, //no//,
+  * 2 reguły z pojedynczym warunkiem,
+  * 83 reguły z dwoma warunkami,
+  * 40 pytań.
+=== Kod programu (tylko silnik) ===
+<code>
+(deftemplate rule
+   (multislot if)
+   (multislot then))
+;;;**************************
+;;;* INFERENCE ENGINE RULES *
+;;;**************************
+(defrule propagate-goal ""
+   (goal is ?goal)
+   (rule (if ?variable $?)
+         (then ?goal ? ?value))
+   =>
+   (assert (goal is ?variable)))
+(defrule goal-satified ""
+   (declare (salience 30))
+   ?f <- (goal is ?goal)
+   (variable ?goal ?value)
+   (answer ? ?text ?goal)
+   =>
+   (retract ?f)
+   (format t "%s%s%n" ?text ?value))
+(defrule remove-rule-no-match ""
+   (declare (salience 20))
+   (variable ?variable ?value)
+   ?f <- (rule (if ?variable ? ~?value $?))
+   =>
+   (retract ?f))
+(defrule modify-rule-match ""
+   (declare (salience 20))
+   (variable ?variable ?value)
+   ?f <- (rule (if ?variable ? ?value and $?rest))
+   =>
+   (modify ?f (if ?rest)))
+(defrule rule-satisfied ""
+   (declare (salience 20))
+   (variable ?variable ?value)
+   ?f <- (rule (if ?variable ? ?value)
+               (then ?goal ? ?goal-value))
+   =>
+   (retract ?f)
+   (assert (variable ?goal ?goal-value)))
+(defrule ask-question-no-legalvalues ""
+   (declare (salience 10))
+   (not (legalanswers $?))
+   ?f1 <- (goal is ?variable)
+   ?f2 <- (question ?variable ? ?text)
+   =>
+   (retract ?f1 ?f2)
+   (format t "%s " ?text)
+   (assert (variable ?variable (read))))
+(defrule ask-question-legalvalues ""
+   (declare (salience 10))
+   (legalanswers ? $?answers)
+   ?f1 <- (goal is ?variable)
+   ?f2 <- (question ?variable ? ?text)
+   =>
+   (retract ?f1)
+   (format t "%s " ?text)
+   (printout t ?answers " ")
+   (bind ?reply (read))
+   (if (member (lowcase ?reply) ?answers)
+     then (assert (variable ?variable ?reply))
+          (retract ?f2)
+     else (assert (goal is ?variable))))
+</code>
+===== 2. Modele ARD i XTT przykładów =====
+Wykonałem schematy ARD oraz XTT systemów [[#Automotive Expert System]] i [[#Animal Identification Expert System]] na podstawie [[hekate:hekate_case_thermostat|termostatu]] i [[hekate:ardplus|opisu teoretycznego]].
+Korzystałem z narzędzi [[hekate:varda|VARDA]] oraz [[hekate:hqed|HQEd]].
+==== Automotive Expert System ====
+=== Schemat ARD ===
+{{:pl:miw:2009:miw09_xtt_clips:auto-ard.png|schemat ARD}}
+=== Schemat TPH ===
+{{:pl:miw:2009:miw09_xtt_clips:auto-tph.png|schemat TPH}}
+=== Schemat XTT ===
+{{:pl:miw:2009:miw09_xtt_clips:auto-xtt.png|schemat XTT}}
+==== Animal Identification Expert System ====
+Ze względu na duże rozmiary schematy są na podstronie [[pl:miw:2009:miw09_xtt_clips:projekt|dodatkowa dokumentacja]].
+==== Wnioski ====
+Na schematach ARD widać, że poszukiwana wartość zależy bezpośrednio od dużej liczby atrybutów.
+Tymczasem w obu systemach dominują reguły o niewielkiej liczbie argumentów - np. system rozpoznawania
+zwierząt korzysta z reguł maksymalnie dwuargumentowych.
+Dzieje się tak, ponieważ prawie każda reguła
+służąca do szukania wartości finalnego atrybutu ma inny zestaw argumentów (atrybutów). Gdyby wszystkie
+reguły dawały się podzielić na kilka takich grup, że w każdej mielibyśmy (prawie) ten sam zestaw
+atrybutów odpowiednio po lewej (warunkowej) i prawej stronie, otrzymane schematy ARD
+byłyby znacznie prostsze.
+===== 3. Termostat w CLIPS =====
+Stworzyłem model termostatu w języku CLIPS zgodnie z [[hekate:hekate_case_thermostat]].
+==== Opis programu ====
+  * Program korzysta z funkcji zapewniających pobranie i walidację danych
+    * //ask-question// sprawdza, czy odpowiedź znajduje się na liście dozwolonych odpowiedzi i ewentualnie ponawia pytanie
+    * //ask-number// sprawdza, czy podana liczba mieści się w wymaganym przedziale,
+  * pierwsze trzy reguły pobierają tylko dane od użytkownika,
+  * pozostałe reguły są odpowiednikami [[hekate:hekate_case_thermostat#Original Rules|opisów słownych]],
+  * aby porównać liczby (lub użyć dowolnej funkcji zwracającej wartości true/false) w części warunkowej reguły, konieczne było zastosowanie słowa kluczowego //test//. Do testu na pojedynczym polu dopasowywanego faktu można też użyć składni wykorzystującej znaki "**&**" i "**:**".
+==== Uruchamianie ====
+Aby uruchomić program, należy otworzyć plik //therm-clips.clp// w środowisku CLIPS, wybrać z menu
+Buffer->Load Buffer, a następnie Execution->Run. Po podaniu miesiąca, dnia tygodnia i godziny zostanie
+wyświetlona odpowiednia temperatura. Jeśli chcemy dodatkowo śledzić dodawanie wszystkich faktów podczas
+wykonywania, przed poleceniem Run należy wpisać w konsoli ''(watch facts)''.
+==== Kod programu ====
+<code>
+;;;**************************************
+;;;Termostat
+;;;Maciej Fabia, MIW 2009
+;;;**************************************
+;;****************
+;;* DEFFUNCTIONS *
+;;****************
+(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)
+(deffunction ask-number (?question ?lower-limit ?upper-limit)
+   (printout t ?question)
+   (bind ?answer (read))
+   (while (not (and (integerp ?answer) (>= ?answer ?lower-limit) (<= ?answer ?upper-limit))) do
+      (printout t ?question)
+      (bind ?answer (read)))
+   ?answer)
+;;************
+;;* RULES    *
+;;************
+(defrule ask-month
+   (not (month ?))
+=>
+   (assert (month (ask-number "Podaj miesiac, liczba 1-12: " 1 12))))
+(defrule ask-day
+   (not (day ?))
+=>
+   (assert (day (ask-question "Podaj dzien, mon/tue/wed/thu/fri/sat/san: " mon tue wed thu fri sat
+sun))))
+(defrule ask-hour
+   (not (hour ?))
+=>
+   (assert (hour (ask-number "Podaj godzine, liczba 0-23: " 0 23))))
+(defrule season-is-winter
+   (month 1|2|12)
+   (not (season ?))
+=>
+   (assert (season winter)))
+(defrule season-is-spring
+   (month 3|4|5)
+   (not (season ?))
+=>
+   (assert (season spring)))
+(defrule season-is-summer
+   (month 6|7|8)
+   (not (season ?))
+=>
+   (assert (season summer)))
+(defrule season-is-fall
+   (month 9|10|11)
+   (not (season ?))
+=>
+   (assert (season fall)))
+(defrule today-is-workday
+   (day mon|tue|wed|thu|fri)
+   (not (today ?))
+=>
+   (assert (today workday)))
+(defrule today-is-weekend
+   (day sat|sun)
+   (not (today ?))
+=>
+   (assert (today weekend)))
+(defrule business-hours
+   (not (business-hours ?))
+   (today workday)
+   (hour ?hour)
+   (test (and (>= ?hour 9) (<= ?hour 17)))
+=>
+   (assert (business-hours yes)))
+(defrule not-business-hours-too-early
+   (not (business-hours ?))
+   (today workday)
+   (hour ?hour)
+   (test (< ?hour 9))
+=>
+   (assert (business-hours no)))
+(defrule not-business-hours-too-late
+   (not (business-hours ?))
+   (today workday)
+   (hour ?hour)
+   (test (> ?hour 17))
+=>
+   (assert (business-hours no)))
+(defrule not-business-hours-weekend
+   (not (business-hours ?))
+   (today weekend)
+=>
+   (assert (business-hours no)))
+(defrule summer-free-time
+   (not (setting ?))
+   (season summer)
+   (business-hours no)
+=>
+   (assert (setting 27)))
+(defrule summer-business
+   (not (setting ?))
+   (season summer)
+   (business-hours yes)
+=>
+   (assert (setting 24)))
+(defrule spring-free-time
+   (not (setting ?))
+   (season spring)
+   (business-hours no)
+=>
+   (assert (setting 15)))
+(defrule spring-business
+   (not (setting ?))
+   (season spring)
+   (business-hours yes)
+=>
+   (assert (setting 20)))
+(defrule winter-free-time
+   (not (setting ?))
+   (season winter)
+   (business-hours no)
+=>
+   (assert (setting 14)))
+(defrule winter-business
+   (not (setting ?))
+   (season winter)
+   (business-hours yes)
+=>
+   (assert (setting 18)))
+(defrule fall-free-time
+   (not (setting ?))
+   (season fall)
+   (business-hours no)
+=>
+   (assert (setting 16)))
+(defrule fall-business
+   (not (setting ?))
+   (season fall)
+   (business-hours yes)
+=>
+   (assert (setting 20)))
+(defrule Answer
+   (setting ?setting)
+=>
+   (printout t "Set thermostat to " ?setting " degrees" crlf))
 </code>
 ====== Spotkania ======
 [[pl:miw:2009:miw09_xtt_clips:spotkania|Notatki ze spotkań projektowych]]
+====== Projekt ======
+[[pl:miw:2009:miw09_xtt_clips:projekt|Dodatkowa dokumentacja]] - schematy ARD, TPH i XTT systemu identyfikującego zwierzęta. Przeniesione ze względu na duże rozmiary.
 ====== Materiały ======
+Kopie lokalne programów CLIPS mają zmienione rozszerzenia z ''clp'' na ''txt''.
+  * [[http://clipsrules.sourceforge.net/OnlineDocs.html|Dokumentacja on-line CLIPS-a]], dla początkujących polecam //User Guide//
+  * [[http://www.cis.ysu.edu/~john/824/examples/EMH7.txt|System wybierający metodę leczenia]], {{:pl:miw:2009:miw09_xtt_clips:emh7.txt|kopia lokalna}}
+  * {{:pl:miw:2009:miw09_xtt_clips:auto.txt|Automotive Expert System:}}, {{:pl:miw:2009:miw09_xtt_clips:auto-model.pl|źródło VARDA}}, {{:pl:miw:2009:miw09_xtt_clips:car_expert_hml.txt|źródło HQEd 6_8}},{{:pl:miw:2009:miw09_xtt_clips:car-expert.xttml|źródło HQEd 5_6}}
+  * {{:pl:miw:2009:miw09_xtt_clips:animal.txt|Rozpoznawanie zwierząt}}, {{:pl:miw:2009:miw09_xtt_clips:anim-model.pl|źródło VARDA}}, {{:pl:miw:2009:miw09_xtt_clips:anim_hml.txt|źródło HQEd 6_8}},{{:pl:miw:2009:miw09_xtt_clips:anim.xttml|źródło HQEd 5_6}}
+  * {{:pl:miw:2009:miw09_xtt_clips:therm_clips.txt|Termostat w CLIPS}}

pl/miw/2009/miw09_xtt_clips.1251200505.txt.gz · ostatnio zmienione: 2019/06/27 15:58 (edycja zewnętrzna)

Pokaż stronę Poprzednie wersje

Menadżer multimediów Do góry

AIwiki

Menu

Dla Studentów

Old specialized AI courses

SMaDA/SMaIDA/AIDA

Informatyka (EAIiIB)

Studia Dr

Inne materialy dydaktyczne

Archiwum

Dyplomanci

Geist Season of Code

HeKatE

Public

Różnice