wine.clp

模糊clips专家系统

(defrule recommend-chardonnay ""
  (phase select-wines)
  (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 ""
  (phase select-wines)
  (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 ""
  (phase select-wines)
  (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 ""
  (phase select-wines)
  (recommended-color white ?per1 ?)
  (recommended-body full ?per2 ?)
  (feature spiciness)
  =>
  (assert (wine Geverztraminer =(min ?per1 ?per2) =(gensym))))

(defrule recommend-chenin-blanc ""
  (phase select-wines)
  (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 ""
  (phase select-wines)
  (recommended-color red ?per1 ?)
  (recommended-body light ?per2 ?)
  =>
  (assert (wine Valpolicella =(min ?per1 ?per2) =(gensym))))

(defrule recommend-zinfandel-and-cabernet-sauvignon ""
  (phase select-wines)
  (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 ""
  (phase select-wines)
  (recommended-color red ?per1 ?)
  (recommended-body medium ?per2 ?)
  (recommended-sweetness medium ?per3 ?)
  =>
  (assert (wine Pinot-Noir =(min ?per1 ?per2 ?per3) =(gensym))))

(defrule recommend-burgundy ""
  (phase select-wines)
  (recommended-color red ?per1 ?)
  (recommended-body full ?per2 ?)
  =>
  (assert (wine Burgundy =(min ?per1 ?per2) =(gensym))))

;;***************
;;* QUERY RULES *
;;***************

(defrule question-1 ""
  ?rem <- (ask-question)
  (not (main-component ?))
  =>
  (retract ?rem)
  (bind ?response
     (ask-question "Is the main component of the meal meat, fish, or poultry? "
                    meat fish poultry unknown))
  (assert (main-component ?response)))

(defrule question-2 ""
  ?rem <- (ask-question)
  (main-component poultry)
  (not (has-turkey ?))
  =>
  (retract ?rem)
  (bind ?response
     (ask-question "Does the meal have turkey in it? "
                    yes no unknown))
  (assert (has-turkey ?response)))

(defrule question-3 ""
  ?rem <- (ask-question)
  (main-component meat)
  (not (has-veal ?))
  =>
  (retract ?rem)
  (bind ?response
     (ask-question "Does the meal have veal in it? "
                    yes no unknown))
  (assert (has-veal ?response)))

(defrule question-4 ""  
  ?rem <- (ask-question)
  (not (has-sauce ?))
  =>
  (retract ?rem)
  (bind ?response
     (ask-question "Does the meal have a sauce on it? "
                    yes no unknown))
  (assert (has-sauce ?response)))

(defrule question-5 ""
  ?rem <- (ask-question)
  (has-sauce yes)
  (not (sauce ?))
  =>
  (retract ?rem)  
  (bind ?response
     (ask-question "Is the sauce for the meal spicy, sweet, cream, or tomato? "
                    sauce spicy sweet cream tomato unknown))
  (assert (sauce ?response)))

(defrule question-6 ""
  ?rem <- (ask-question)
  (not (tastiness ?))
  =>
  (retract ?rem)
  (bind ?response
     (ask-question "Is the flavor of the meal delicate, average, or strong? "
                    delicate average strong unknown))
  (assert (tastiness ?response)))

(defrule question-7 ""
  ?rem <- (ask-question)
  (not (preferred-body ?))
  =>
  (retract ?rem)
  (bind ?response
     (ask-question "Do you generally prefer light, medium, or full bodied wines? "
                    light medium full unknown))
  (assert (preferred-body ?response)))

(defrule question-8 ""
  ?rem <- (ask-question)
  (not (preferred-color ?))
  =>
  (retract ?rem)
  (bind ?response
     (ask-question "Do you generally prefer red or white wines? "
                    red white unknown))
  (assert (preferred-color ?response)))

(defrule question-9 ""
  ?rem <- (ask-question)
  (not (preferred-sweetness ?))
  =>
  (retract ?rem)
  (bind ?response
     (ask-question "Do you generally prefer dry, medium, or sweet wines? "
                    dry medium sweet unknown))
  (assert (preferred-sweetness ?response))) 

(defrule ask-another-question ""
  (not (ask-question))
  =>
  (assert (ask-question)))

;;*****************************
;;* PRINT SELECTED WINE RULES *
;;*****************************

(defrule print-wine ""
  (phase print-wines)
  ?rem <- (wine ?name ?per ?)		  
  (not (wine ?name1 ?per1&:(> ?per1 ?per) ?))
  =>
  (retract ?rem)
  (format t " %-24s %2d%%%n" ?name ?per))

(defrule end-spaces ""
   (phase print-wines)
   (not (wine ? ? ?))
   =>
   (printout t t))

;;*******************************
;;* ELIMINATE POOR CHOICES RULE *
;;*******************************

(defrule remove-poor-wine-choices ""
  (phase remove-poor-choices)
  ?rem <- (wine ? ?per ?)
  (test (< ?per 20))
  =>
  (retract ?rem))

;;****************************
;;* COMBINE CERTAINTIES RULE *
;;****************************

(defrule combine-certainties ""
  (declare (salience 10000))
  (combine ?rel)
  ?rem1 <- (?rel ?val ?per1 ?sym1)
  ?rem2 <- (?rel ?val ?per2 ?sym2&~?sym1)
  =>
  (retract ?rem1 ?rem2)
  (assert (?rel ?val
		=(/ (- (* 100 (+ ?per1 ?per2)) (* ?per1 ?per2)) 100)
		=(gensym))))
		
;;**************************************
;;* PHASE CONTROL RULES                *
;;*   PHASE 0: Ask Questions           *
;;*   PHASE 1: Choose Best Qualities   *
;;*   PHASE 2: Choose Recommended      *
;;*            Qualities               *
;;*   PHASE 3: Check for Default       *
;;*            Recommended Qualities   *
;;*   PHASE 4: Select Wines based on   *
;;*            Recommended Qualities   *
;;*   PHASE 5: Remove Wine Selections  *
;;*            with Low Certainties    *
;;*   PHASE 6: Display Wine Selections *
;;**************************************

(defrule change-to-phase-1 ""
   (declare (salience -10))
   =>
   (assert (phase choose-qualities)))

(defrule change-to-phase-2 ""
   (declare (salience -10))
   ?phase <- (phase choose-qualities)
   =>
   (retract ?phase)
   (assert (phase recommend-qualities)))

(defrule change-to-phase-3 ""
   (declare (salience -10))
   ?phase <- (phase recommend-qualities)
   =>
   (retract ?phase)
   (assert (phase default-qualities)))

(defrule change-to-phase-4 ""
   (declare (salience -10))
   ?phase <- (phase default-qualities)
   =>
   (retract ?phase)
   (assert (phase select-wines)))

(defrule change-to-phase-5 ""
   (declare (salience -10))
   ?phase <- (phase select-wines)
   =>
   (retract ?phase)
   (assert (phase remove-poor-choices)))

(defrule change-to-phase-6 ""
   (declare (salience -10))
   ?phase <- (phase remove-poor-choices)
   =>
   (retract ?phase)
   (printout t t)
   (printout t "        SELECTED WINES" t t)
   (printout t " WINE                  CERTAINTY" t)
   (printout t " -------------------------------" t)
   (assert (phase print-wines)))