wine.clp

模糊clips专家系统

;;;======================================================
;;;   Wine Expert Sample Problem
;;;
;;;     WINEX: The WINe EXpert system.
;;;     This example selects an appropriate wine
;;;     to drink with a meal.
;;;
;;;     CLIPS Version 5.1 Example
;;;     Modified to run in wxCLIPS
;;;
;;;     To execute, merely load, reset and run.
;;;======================================================

;;****************
;;* DEFFUNCTIONS *
;;****************

(deffunction ask-question (?question $?allowed-values)
   (bind ?ans (get-text-from-user ?question))
   (bind ?answer none)
   (if (eq ?ans "") then (halt)
    else
    (bind ?answer (string-to-symbol (lowcase ?ans)))
    (while (and (not (member ?answer ?allowed-values)) (neq ?ans "")) do
      (bind ?ans (get-text-from-user ?question))
      (bind ?answer (string-to-symbol (lowcase ?ans)))
    )
   )
    ?answer)

;;*****************
;;* INITIAL STATE *
;;*****************

(deffacts valid-combinations ""
  (combine best-body)
  (combine best-color)
  (combine best-sweetness)
  (combine recommended-body)
  (combine recommended-color)
  (combine recommended-sweetness)
  (combine wine))

;;*******************************
;;* CHOOSE WINE QUALITIES RULES *
;;*******************************

(defrule choose-body-for-spicy-sauce ""
  (phase choose-qualities)
  (has-sauce yes)
  (sauce spicy)
  =>
  (assert (best-body full 100 =(gensym))))

(defrule choose-body-for-delicate-taste "" 
  (phase choose-qualities)
  (tastiness delicate)
  =>
  (assert (best-body light 100 =(gensym))))

(defrule choose-body-for-average-taste ""
  (phase choose-qualities)
  (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 ""
  (phase choose-qualities)
  (tastiness strong)
  =>
  (assert (best-body medium 40 =(gensym)))
  (assert (best-body full 80 =(gensym))))

(defrule choose-body-for-cream-sauce ""
  (phase choose-qualities)
  (has-sauce yes)
  (sauce cream)
  =>
  (assert (best-body medium 40 =(gensym)))
  (assert (best-body full 60 =(gensym))))

(defrule choose-color-for-meat ""
  (phase choose-qualities)
  (main-component meat)
  (has-veal no)
  =>
  (assert (best-color red 90 =(gensym))))

(defrule choose-color-for-poultry ""
  (phase choose-qualities)
  (main-component poultry)
  (has-turkey no)
  =>
  (assert (best-color white 90 =(gensym)))
  (assert (best-color red 30 =(gensym))))

(defrule choose-color-for-fish ""
  (phase choose-qualities)
  (main-component fish)
  =>
  (assert (best-color white 100 =(gensym))))

(defrule choose-color-for-tomato-sauce ""
  (phase choose-qualities)
  (not (main-component fish))
  (has-sauce yes)
  (sauce tomato)
  =>
  (assert (best-color red 100 =(gensym))))

(defrule choose-color-for-turkey ""
  (phase choose-qualities)
  (main-component poultry)
  (has-turkey yes)
  =>
  (assert (best-color red 80 =(gensym)))
  (assert (best-color white 50 =(gensym))))

(defrule choose-color-for-cream-sauce ""
  (phase choose-qualities)
  (main-component unknown)
  (has-sauce yes)
  (sauce cream)
  =>
  (assert (best-color white 40 =(gensym))))

(defrule choose-color-for-sweet-sauce ""
  (phase choose-qualities)
  (has-sauce yes)
  (sauce sweet)
  =>
  (assert (best-sweetness sweet 90 =(gensym)))
  (assert (best-sweetness medium 40 =(gensym))))

(defrule spicy-sauce-is-spicy-feature ""
  (phase choose-qualities)
  (has-sauce yes)
  (sauce spicy)
  =>
  (assert (feature spiciness)))

(defrule best-body-always-recommended ""
  (phase recommend-qualities)
  (best-body ?body ?per ?)
  =>
  (assert (recommended-body ?body ?per =(gensym))))

(defrule preferred-body-may-be-recommended ""
  (phase recommend-qualities)
  (preferred-body ?body)
  (best-body ?body ?per ?)
  =>
  (assert (recommended-body ?body =(/ (* 20 ?per) 100) =(gensym))))

(defrule recommend-medium-body-1 ""
  (phase recommend-qualities)
  (preferred-body light)
  (best-body full ?per ?)
  =>
  (assert (recommended-body medium ?per =(gensym))))

(defrule recommend-medium-body-2 ""
  (phase recommend-qualities)
  (preferred-body full)
  (best-body light ?per ?)
  =>
  (assert (recommended-body medium ?per =(gensym))))

(defrule best-color-always-recommended ""
  (phase recommend-qualities)
  (best-color ?color ?per ?)
  =>
  (assert (recommended-color ?color ?per =(gensym))))

(defrule preferred-color-may-be-recommended
  (phase recommend-qualities)
  (preferred-color ?color)
  (best-color ?color ?per ?)
  =>
  (assert (recommended-color ?color =(/ (* 20 ?per) 100) =(gensym))))

(defrule preferred-color-is-unknown ""
  (phase recommend-qualities)
  (preferred-color unknown)
  =>
  (assert (recommended-color white 50 =(gensym)))
  (assert (recommended-color red 50 =(gensym))))

(defrule best-sweetness-always-recommended ""
  (phase recommend-qualities)
  (best-sweetness ?sweet ?per ?)
  =>
  (assert (recommended-sweetness ?sweet ?per =(gensym))))

(defrule preferred-sweetness-may-be-recommended ""
  (phase recommend-qualities)
  (best-sweetness ?sweet ?per ?)
  (preferred-sweetness ?sweet)
  =>
  (assert (recommended-sweetness ?sweet =(/ (* 20 ?per) 100) =(gensym))))

(defrule recommend-medium-sweetness-1 ""
  (phase recommend-qualities)
  (best-sweetness sweet ?per ?)
  (preferred-sweetness dry)
  =>
  (assert (recommended-sweetness medium ?per =(gensym))))

(defrule recommend-medium-sweetness-2 ""
  (phase recommend-qualities)
  (best-sweetness dry ?per ?)
  (preferred-sweetness sweet)
  =>
  (assert (recommended-sweetness medium ?per =(gensym))))

;;*************************************
;;* DEFAULT QUALITIES SELECTION RULES *
;;*************************************

(defrule use-prefered-body-if-no-best-body ""
  (phase default-qualities)
  (preferred-body ?body&~unknown)
  (not (best-body ? ? ?))
  =>
  (assert (recommended-body ?body 100 =(gensym))))    

(defrule use-medium-body-if-no-best-body ""
  (phase default-qualities)
  (not (best-body ? ? ?))
  =>
  (assert (recommended-body medium 100 =(gensym))))

(defrule use-preferred-color-if-no-best-color ""
  (phase default-qualities)
  (preferred-color ?color&~unknown)
  (not (best-color ? ? ?))
  =>
  (assert (recommended-color ?color 100 =(gensym))))

(defrule use-medium-sweetness-if-preference-unknown ""
  (phase default-qualities)
  (not (best-sweetness ? ? ?))
  (preferred-sweetness unknown)
  =>
  (assert (recommended-sweetness medium 100 =(gensym))))

(defrule use-preferred-sweetness-if-no-best-sweetness ""
  (phase default-qualities)
  (not (best-sweetness ? ? ?))
  (preferred-sweetness ?sweet&~unknown)
  =>
  (assert (recommended-sweetness ?sweet 100 =(gensym))))

;;************************
;;* WINE SELECTION RULES *
;;************************

(defrule recommend-gamay ""
  (phase select-wines)
  (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 ""
  (phase select-wines)
  (recommended-color white ?per1 ?)
  (recommended-body light ?per2 ?)
  (recommended-sweetness dry ?per3 ?)
  =>
  (assert (wine Chablis =(min ?per1 ?per2 ?per3) =(gensym))))

(defrule recommend-sauvignon-blanc ""
  (phase select-wines)
  (recommended-color white ?per1 ?)
  (recommended-body medium ?per2 ?)
  (recommended-sweetness dry ?per3 ?)
  =>
  (assert (wine Sauvignon-Blanc =(min ?per1 ?per2 ?per3) =(gensym))))