Różnice

Różnice między wybraną wersją a wersją aktualną.

Odnośnik do tego porównania

Both sides previous revision Poprzednia wersja
Nowa wersja
Poprzednia wersja
pl:miw:2009:miw09_xtt_clips [2009/08/24 18:06]
jsi08
pl:miw:2009:miw09_xtt_clips [2009/09/25 17:48]
jsi08
Linia 1: Linia 1:
 +~~ODT~~
 ====== MIW 2009 XTT_CLIPS ====== ====== MIW 2009 XTT_CLIPS ======
   *Zrealizował:​ [[mfabia@student.agh.edu.pl|Maciej Fabia]] (4RI)   *Zrealizował:​ [[mfabia@student.agh.edu.pl|Maciej Fabia]] (4RI)
Linia 9: Linia 10:
  
 ====== Sprawozdanie ====== ====== Sprawozdanie ======
 +===== 1. 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.
 +
 +==== 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:
 +  - 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 ===
 +<​code>​
 +(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))
 +</​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 ====== ====== Spotkania ======
Linia 14: Linia 739:
  
 ====== Projekt ====== ====== Projekt ======
-====== Sprawozdanie ====== +[[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. 
-====== Prezentacja ======+
 ====== Materiały ====== ====== 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.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