home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Computer Club Elmshorn Atari PD
/
CCE_PD.iso
/
pc
/
0600
/
CCE_0622.ZIP
/
CCE_0622.PD
/
CLIPS
/
WINE.CLP
< prev
Wrap
Text File
|
1993-09-01
|
11KB
|
448 lines
;; math.c extended package must be linked with clips
;; for this example to work
(defrule choose-body-for-spicy-sauce ""
(declare (salience 1000))
(has-sauce yes)
(sauce spicy)
=>
(assert (best-body full 100 =(gensym))))
(defrule choose-body-for-delicate-taste ""
(declare (salience 1000))
(tastiness delicate)
=>
(assert (best-body light 100 =(gensym))))
(defrule choose-body-for-average-taste ""
(declare (salience 1000))
(tastiness average)
=>
(assert (best-body light 30 =(gensym)))
(assert (best-body medium 60 =(gensym)))
(assert (best-body full 30 =(gensym))))
(defrule choose-body-for-strong-taste ""
(declare (salience 1000))
(tastiness strong)
=>
(assert (best-body medium 40 =(gensym)))
(assert (best-body full 80 =(gensym))))
(defrule choose-body-for-cream-sauce ""
(declare (salience 1000))
(has-sauce yes)
(sauce cream)
=>
(assert (best-body medium 40 =(gensym)))
(assert (best-body full 60 =(gensym))))
(defrule choose-color-for-meat ""
(declare (salience 1000))
(main-component meat)
(has-veal no)
=>
(assert (best-color red 90 =(gensym))))
(defrule choose-color-for-poultry ""
(declare (salience 1000))
(main-component poultry)
(has-turkey no)
=>
(assert (best-color white 90 =(gensym)))
(assert (best-color red 30 =(gensym))))
(defrule choose-color-for-fish ""
(declare (salience 1000))
(main-component fish)
=>
(assert (best-color white 100 =(gensym))))
(defrule choose-color-for-tomato-sauce ""
(declare (salience 1000))
(not (main-component fish))
(has-sauce yes)
(sauce tomato)
=>
(assert (best-color red 100 =(gensym))))
(defrule choose-color-for-turkey ""
(declare (salience 1000))
(main-component poultry)
(has-turkey yes)
=>
(assert (best-color red 80 =(gensym)))
(assert (best-color white 50 =(gensym))))
(defrule choose-color-for-cream-sauce ""
(declare (salience 1000))
(main-component unknown)
(has-sauce yes)
(sauce cream)
=>
(assert (best-color white 40 =(gensym))))
(defrule choose-color-for-sweet-sauce ""
(declare (salience 1000))
(has-sauce yes)
(sauce sweet)
=>
(assert (best-sweetness sweet 90 =(gensym)))
(assert (best-sweetness medium 40 =(gensym))))
(defrule spicy-sauce-is-spicy-feature ""
(declare (salience 1000))
(has-sauce yes)
(sauce spicy)
=>
(assert (feature spiciness)))
(defrule rule-14 ""
(declare (salience 1000))
(best-body ?body ?per ?)
=>
(assert (recommended-body ?body ?per =(gensym))))
(defrule rule-17 ""
(declare (salience 1000))
(preferred-body ?body)
(best-body ?body ?per ?)
=>
(assert (recommended-body ?body =(/ (* 20 ?per) 100) =(gensym))))
(defrule rule-20 ""
(declare (salience 1000))
(preferred-body light)
(best-body full ?per ?)
=>
(assert (recommended-body medium ?per =(gensym))))
(defrule rule-21 ""
(declare (salience 1000))
(preferred-body full)
(best-body light ?per ?)
=>
(assert (recommended-body medium ?per =(gensym))))
(defrule use-prefered-body-if-no-best-body ""
(preferred-body ?body)
(not (best-body ? ? ?))
=>
(assert (recommended-body ?body 100 =(gensym))))
(defrule use-medium-body-if-no-best-body ""
(not (best-body ? ? ?))
=>
(assert (recommended-body medium 100 =(gensym))))
(defrule rule-26 ""
(declare (salience 1000))
(best-color ?color ?per ?)
=>
(assert (recommended-color ?color ?per =(gensym))))
(defrule rule-28 ""
(declare (salience 1000))
(preferred-color ?color)
(best-color ?color ?per ?)
=>
(assert (recommended-color ?color =(/ (* 20 ?per) 100) =(gensym))))
(defrule use-preferred-color-if-no-best-color ""
(preferred-color ?color)
(not (best-color ? ? ?))
=>
(assert (recommended-color ?color 100 =(gensym))))
(defrule preferred-color-is-unknown ""
(declare (salience 1000))
(preferred-color unknown)
=>
(assert (recommended-color white 50 =(gensym)))
(assert (recommended-color red 50 =(gensym))))
(defrule rule-33 ""
(declare (salience 1000))
(best-sweetness ?sweet ?per ?)
=>
(assert (recommended-sweetness ?sweet ?per =(gensym))))
(defrule rule-36 ""
(not (best-sweetness ? ? ?))
(preferred-sweetness unknown)
=>
(assert (recommended-sweetness medium 100 =(gensym))))
(defrule rule-37 ""
(declare (salience 1000))
(best-sweetness ?sweet ?per ?)
(preferred-sweetness ?sweet)
=>
(assert (recommended-sweetness ?sweet =(/ (* 20 ?per) 100) =(gensym))))
(defrule rule-40 ""
(not (best-sweetness ? ? ?))
(preferred-sweetness ?sweet)
=>
(assert (recommended-sweetness ?sweet 100 =(gensym))))
(defrule rule-43 ""
(declare (salience 1000))
(best-sweetness sweet ?per ?)
(preferred-sweetness dry)
=>
(assert (recommended-sweetness medium ?per =(gensym))))
(defrule rule-44 ""
(declare (salience 1000))
(best-sweetness dry ?per ?)
(preferred-sweetness sweet)
=>
(assert (recommended-sweetness medium ?per =(gensym))))
(defrule recommend-gamay ""
(declare (salience -1000))
(recommended-color red ?per1 ?)
(recommended-body medium ?per2 ?)
(or (recommended-sweetness medium ?per3 ?)
(recommended-sweetness sweet ?per3 ?))
=>
(assert (wine gamay =(min ?per1 ?per2 ?per3) =(gensym))))
(defrule recommend-chablis ""
(declare (salience -1000))
(recommended-color white ?per1 ?)
(recommended-body light ?per2 ?)
(recommended-sweetness dry ?per3 ?)
=>
(assert (wine chablis =(min ?per1 ?per2 ?per3) =(gensym))))
(defrule recommend-sauvignon-blanc ""
(declare (salience -1000))
(recommended-color white ?per1 ?)
(recommended-body medium ?per2 ?)
(recommended-sweetness dry ?per3 ?)
=>
(assert (wine sauvignon-blanc =(min ?per1 ?per2 ?per3) =(gensym))))
(defrule recommend-chardonnay ""
(declare (salience -1000))
(recommended-color white ?per1 ?)
(or (recommended-body medium ?per2 ?)
(recommended-body full ?per2 ?))
(or (recommended-sweetness medium ?per3 ?)
(recommended-sweetness dry ?per3 ?))
=>
(assert (wine chardonnay =(min ?per1 ?per2 ?per3) =(gensym))))
(defrule recommend-soave ""
(declare (salience -1000))
(recommended-color white ?per1 ?)
(recommended-body light ?per2 ?)
(or (recommended-sweetness medium ?per3 ?)
(recommended-sweetness dry ?per3 ?))
=>
(assert (wine soave =(min ?per1 ?per2 ?per3) =(gensym))))
(defrule recommend-riesling ""
(declare (salience -1000))
(recommended-color white ?per1 ?)
(or (recommended-body light ?per2 ?)
(recommended-body medium ?per2 ?))
(or (recommended-sweetness medium ?per3 ?)
(recommended-sweetness sweet ?per3 ?))
=>
(assert (wine riesling =(min ?per1 ?per2 ?per3) =(gensym))))
(defrule recommend-geverztraminer ""
(declare (salience -1000))
(recommended-color white ?per1 ?)
(recommended-body full ?per2 ?)
(feature spiciness)
=>
(assert (wine geverztraminer =(min ?per1 ?per2) =(gensym))))
(defrule recommend-chenin-blanc ""
(declare (salience -1000))
(recommended-color white ?per1 ?)
(recommended-body light ?per2 ?)
(or (recommended-sweetness medium ?per3 ?)
(recommended-sweetness sweet ?per3 ?))
=>
(assert (wine chenin-blanc =(min ?per1 ?per2 ?per3) =(gensym))))
(defrule recommend-valpolicella ""
(declare (salience -1000))
(recommended-color red ?per1 ?)
(recommended-body light ?per2 ?)
=>
(assert (wine valpolicella =(min ?per1 ?per2) =(gensym))))
(defrule recommend-zinfandel-and-cabernet-sauvignon ""
(declare (salience -1000))
(recommended-color red ?per1 ?)
(or (recommended-sweetness medium ?per2 ?)
(recommended-sweetness dry ?per2 ?))
=>
(assert (wine cabernet-sauvignon =(min ?per1 ?per2) =(gensym)))
(assert (wine zinfandel =(min ?per1 ?per2) =(gensym))))
(defrule recommend-pinot-noir ""
(declare (salience -1000))
(recommended-color red ?per1 ?)
(recommended-body medium ?per2 ?)
(recommended-sweetness medium ?per3 ?)
=>
(assert (wine pinot-noir =(min ?per1 ?per2 ?per3) =(gensym))))
(defrule recommend-burgundy ""
(declare (salience -1000))
(recommended-color red ?per1 ?)
(recommended-body full ?per2 ?)
=>
(assert (wine burgundy =(min ?per1 ?per2) =(gensym))))
;;
;; question 1
;;
(defrule question-1 ""
(declare (salience 9900))
(initial-fact)
=>
(printout crlf "Is the main component of the meal meat, fish, or poultry? ")
(assert (main-component =(read))))
;;
;; question 2
;;
(defrule question-2 ""
(declare (salience 9800))
(main-component poultry)
=>
(printout "Does the meal have turkey in it? ")
(assert (has-turkey =(read))))
;;
;; question 3
;;
(defrule question-3 ""
(declare (salience 9700))
(main-component meat)
=>
(printout "Does the meal have veal in it? ")
(assert (has-veal =(read))))
;;
;; question 4
;;
(defrule question-4 ""
(declare (salience 9600))
(initial-fact)
=>
(printout "Does the meal have a sauce on it? ")
(assert (has-sauce =(read))))
;;
;; question 5
;;
(defrule question-5 ""
(declare (salience 9500))
(has-sauce yes)
=>
(printout "Is the sauce for the meal spicy, sweet, cream, or tomato? ")
(assert (sauce =(read))))
;;
;; question 6
;;
(defrule question-6 ""
(declare (salience 9400))
(initial-fact)
=>
(printout "Is the flavor of the meal delicate, average, or strong? ")
(assert (tastiness =(read))))
;;
;; question 7
;;
(defrule question-7 ""
(declare (salience 9300))
(initial-fact)
=>
(printout "Do you generally prefer light, medium, or full bodied wines? ")
(assert (preferred-body =(read))))
;;
;; question 8
;;
(defrule question-8 ""
(declare (salience 9200))
(initial-fact)
=>
(printout "Do you generally prefer red or white wines? ")
(assert (preferred-color =(read))))
;;
;; question 9
;;
(defrule question-9 ""
(declare (salience 9100))
(initial-fact)
=>
(printout "Do you generally prefer dry, medium, or sweet wines? ")
(assert (preferred-sweetness =(read))))
(defrule print-wine ""
(declare (salience -6000))
?rem <- (wine ?name ?per ?)
(not (wine ?name1 ?per1&:(> ?per1 ?per) ?))
=>
(retract ?rem)
(printout "wine " ?name " " ?per crlf))
;;
;; percent rule 1
;;
(defrule percent-rule-1 ""
(declare (salience -5000))
?rem <- (? ? ?per ?)
(test (< ?per 20))
=>
(retract ?rem))
;;
;; percent rule 2
;;
(defrule percent-rule-2 ""
(declare (salience 10000))
?rem1 <- (?rel ?val ?per1 ?sym1)
?rem2 <- (?rel ?val ?per2 ?sym2&~?sym1)
=>
(retract ?rem1 ?rem2)
(assert (?rel ?val
=(/ (- (* 100 (+ ?per1 ?per2)) (* ?per1 ?per2)) 100)
=(gensym))))