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:
otworzyć plik z rozszerzeniem „clp”,
wybrać z menu Buffer→Load Buffer,
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:
wzorce wymagające istnienia pewnego faktu,
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:
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ł:
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))
Spotkania
Materiały