Export page to Open Document format

MIW 2009 XTT_CLIPS

Analyze how to design CLIPS and Jess rules with XTT2. Model HeKatE cases in Clips/Jess

Prezentacja

Sprawozdanie

1. Przykłady systemów ekspertowych w CLIPS

Aby uruchomić program w CLIPS, należy:

  1. otworzyć plik z rozszerzeniem „clp”,
  2. wybrać z menu Buffer→Load Buffer,
  3. Execution→Run.

Jeśli uruchamiamy program ponownie, musimy wyczyścić listę faktów poleceniem Execution→Reset.

1.1. Prosty system wybierający metodę leczenia

Przeznaczenie

System poszerza bazę wiedzy zadając pytania na temat stanu zdrowia chorego. W zależności od udzielonych 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

System posiada 15 reguł, w tym:

  • 4 reguły bezargumentowe - są aktywowane po każdym uruchomieniu programu. Każda z nich zadaje pytanie i po uzyskaniu odpowiedzi wstawia odpowiedni fakt,
  • 5 reguł jednoargumentowych,
  • 5 reguł dwuargumentowe,
  • 1 reguła trójargumentowa.

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:

  1. wzorce wymagające istnienia pewnego faktu,
  2. deklaracje priorytetów.

Trzy reguły posiadają zmodyfikowany priorytet:

  • „Measles” - diagnozowanie odry. Posiada podwyższony priotytet, ponieważ w pozostałych regułach założono, że chory nie choruje na odrę.
  • „Allergy1” - obniżony priorytet. Jest sprawdzana jako ostatnia spośród reguł diagnozujących.
  • „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

(defrule GetTemperature
   =>
   (printout t "Enter patient temperature: ")
   (bind ?response (read))
   (assert (temperature ?response)))

(defrule GetSpots
   =>
   (printout t "Does the patient have spots (yes or no): ")
   (bind ?response (read))
   (assert (spots ?response)))

(defrule GetRash
   =>
   (printout t "Does the patient have a rash (yes or no): ")
   (bind ?response (read))
   (assert (rash ?response)))

(defrule GetSoreThroat
   =>
   (printout t "Does the patient have a sore throat (yes or no): ")
   (bind ?response (read))
   (assert (sore_throat ?response)))

; We can also ask for certain information only if necessary. For example,
; it doesn't make sense to ask whether the patient has been innoculated
; unless there is a possiblity of measles.

(defrule GetInnoculated
   (fever high)
   (spots yes)
   =>
   (printout t "Has the patient been innoculated for measles (yes or no): ")
   (bind ?response (read))
   (assert (innoculated ?response)))

; Rules for concluding fever from temperature.

; Note that these rules find the patient temperature, and then bind
; it to ?t. The next part uses the test keyword to evaluate the
; conditional expression as true or false.

(defrule Fever1
   (temperature ?t)
   (test (>= ?t 101))
   =>
   (assert (fever high))
   (printout t "High fever diagnosed" crlf))

(defrule Fever2
   (temperature ?t)
   (test (and (< ?t 101) (> ?t 98.6)))
   =>
   (assert (fever mild))
   (printout t "Mild fever diagnosed" crlf))

; Rules for determining diagnosis on the basis of patient symptoms
; Salience added to give this rule priority

(defrule Measles
   (declare (salience 100))
   (spots yes)
   (innoculated no)
   (fever high)
   =>
   (assert (diagnosis measles))
   (printout t "Measles diagnosed" crlf))

; Modified to only fire if no measles

(defrule Allergy1
   (declare (salience -100))
   (and (spots yes)
        (not (diagnosis measles)))      
   =>
   (assert (diagnosis allergy))
   (printout t "Allergy diagnosed from spots and lack of measles" crlf))   

(defrule Allergy2
   (rash yes)
   =>
   (assert (diagnosis allergy))
   (printout t "Allergy diagnosed from rash" crlf))

(defrule Flu
   (sore_throat yes)
   (fever mild|high)
   =>
   (assert (diagnosis flu))
   (printout t "Flu diagnosed" crlf))

; Rules for recommedaing treatments on the basis of
; Diagnosis facts created.

(defrule Penicillin
   (diagnosis measles)
   =>
   (assert (treatment penicillin))
   (printout t "Penicillin prescribed" crlf))

(defrule Allergy_pills
   (diagnosis allergy)
   =>
   (assert (treatment allergy_shot))
   (printout t "Allergy shot prescribed" crlf))

(defrule Bed_rest
   (diagnosis flu)
   =>
   (assert (treatment bed_rest))
   (printout t "Bed rest prescribed" crlf))

(defrule None
   (declare (salience -100))
   (not (diagnosis ?))
   =>
   (printout t "No diagnosis possible -- consult human expert" crlf))

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:

  1. wzorce wymagające instnienia pewnego faktu,
  2. wzorce wymagające nieistnienia pewnego faktu,
  3. połączenie przypadków 1 i 2 łącznikami logicznymi and, or,
  4. 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

;;;======================================================
;;;   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))

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)

(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))))

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 termostatu i opisu teoretycznego. Korzystałem z narzędzi VARDA oraz HQEd.

Automotive Expert System

Schemat ARD

schemat ARD

Schemat TPH

schemat TPH

Schemat XTT

schemat XTT

Animal Identification Expert System

Ze względu na duże rozmiary schematy są na podstronie 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_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 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

;;;**************************************
;;;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))

Spotkania

Projekt

Dodatkowa dokumentacja - schematy ARD, TPH i XTT systemu identyfikującego zwierzęta. Przeniesione ze względu na duże rozmiary.

Materiały

pl/miw/2009/miw09_xtt_clips.txt · ostatnio zmienione: 2019/06/27 15:50 (edycja zewnętrzna)
www.chimeric.de Valid CSS Driven by DokuWiki do yourself a favour and use a real browser - get firefox!! Recent changes RSS feed Valid XHTML 1.0