• Zrealizował: Maciej Fabia (4RI)

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

Prezentacja wyników projektowych

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.

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.

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.

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

System diagnozuje rodzaj awarii samochodu.

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.

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

Notatki ze spotkań projektowych