To jest stara wersja strony!


MIW 2009 XTT_CLIPS

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

Prezentacja

Sprawozdanie

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.

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

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

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)

;;;======================================================
;;;   Animal Identification Expert System
;;;
;;;     A simple expert system which attempts to identify
;;;     an animal based on its characteristics.
;;;     The knowledge base in this example is a 
;;;     collection of facts which represent backward
;;;     chaining rules. CLIPS forward chaining rules are
;;;     then used to simulate a backward chaining inference
;;;     engine.
;;;
;;;     CLIPS Version 6.0 Example
;;; 
;;;     To execute, merely load, reset, and run.
;;;     Answer questions yes or no.
;;;======================================================

;;;***************************
;;;* DEFTEMPLATE DEFINITIONS *
;;;***************************

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

Spotkania

Materiały

pl/miw/2009/miw09_xtt_clips.1251224408.txt.gz · ostatnio zmienione: 2019/06/27 15:58 (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