Różnice

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

Odnośnik do tego porównania

pl:miw:2009:miw09_xtt_clips [2009/09/03 09:44]
jsi08
pl:miw:2009:miw09_xtt_clips [2019/06/27 15:50]
Linia 1: Linia 1:
-~~ODT~~ 
-====== MIW 2009 XTT_CLIPS ====== 
-  *Zrealizował:​ [[mfabia@student.agh.edu.pl|Maciej Fabia]] (4RI) 
  
-Analyze how to design CLIPS and Jess rules with XTT2. 
-Model HeKatE cases in Clips/Jess 
- 
-====== Prezentacja ====== 
-[[pl:​miw:​2009:​miw09_xtt_clips:​prezentacja|Prezentacja wyników projektowych]] 
- 
-====== 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 === 
-<​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>​ 
- 
-==== 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>​ 
- 
-==== 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>​ 
- 
-===== Modele ARD systemów w języku CLIPS ===== 
- 
-Wykonałem schematy ARD 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ędzia [[hekate:​varda|VARDA]]. 
- 
-==== 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}} 
- 
-==== 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. ​ 
- 
-===== 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 ====== 
-[[pl:​miw:​2009:​miw09_xtt_clips:​spotkania|Notatki ze spotkań projektowych]] 
- 
-====== Projekt ====== 
-[[pl:​miw:​2009:​miw09_xtt_clips:​projekt|Dodatkowa dokumentacja]] - schematy ARD i TPH systemu identyfikującego zwierzęta. Przeniesione ze względu na duże rozmiary. 
- 
-====== Materiały ====== 
-Kopie lokalne programów CLIPS mają zmienione rozszerzenia z ''​clp''​ na ''​txt''​. 
- 
-  * [[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}} 
-  * //​Automotive Expert System// i //Animal Identification System// są dołączone do [[http://​clipsrules.sourceforge.net|dystrybucji CLIPS-a]]. Kopie lokalne: {{:​pl:​miw:​2009:​miw09_xtt_clips:​auto.txt|automotive}},​ {{:​pl:​miw:​2009:​miw09_xtt_clips:​animal.txt|animal}} 
-  * {{:​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