;;;======================================================
;;;   Wine Expert Sample Problem OOP Version - wineOOP.clp
;;;
;;;   In theory, this program should give the same results
;;;   as the non-OOP version, wine.clp
;;;
;;;     WINEX: The WINe EXpert system.
;;;     This example selects an appropriate wine
;;;     to drink with a meal.
;;;
;;;     CLIPS Version 6.0 Example
;;;
;;;     To execute, merely load, reset and run.
;;;======================================================
;;; Original code by Gary Riley, from the CLIPS web site www.ghg.net/clips/CLIPS.html
;;;
;;; Modifications made by Chris Lehman www.thecwlzone.com:
;;; Added astringency characteristic
;;;
;;; Added more wines to list
;;;
;;; Converted code to COOL syntax:
;;;   deftemplates become defclasses
;;;   deffacts become definstances
;;;   retract statements turn into unmake-instance statements
;;;   assert statements become make-instance statements
;;;   modify statements become modify-instance statements
;;;   In defrules, objects are instantiated from the appropriate defclass declarations
;;;
;;; Changed multislot declarations in defclass WINES::WINE to single slot,
;;; modified defrule WINES::generate-wines accordingly.
;;;
;;; Integrate with WebCLIPS
;;;

(defmodule MAIN
  (import WebCLIPSHTML deffunction ?ALL)
  (import WebCLIPSTemplates deftemplate ?ALL)
  (export ?ALL))

;;*****************
;;* INITIAL STATE *
;;*****************
(defclass MAIN::ATTRIBUTE
  (is-a USER)
  (role concrete)
  (slot att-name
	(create-accessor read-write))
  (slot value
	(create-accessor read-write))
  (slot certainty
	(default 100.0)
	(create-accessor read-write)))

(defrule MAIN::start
  (declare (salience 10000))
  =>
;;  (watch instances)
;;  (watch rules)
  (load-instances /tmp/GUIinstances.clp)
;;
;; To run this program manually, comment out the "load-instances" command
;; above, and uncomment the section below to "hard code" some values.
;;
;;  (instances MAIN ATTRIBUTE)
;;  (make-instance of ATTRIBUTE
;;		 (att-name preferred-sweetness)
;;		 (value dry))
;; (make-instance of ATTRIBUTE
;;		 (att-name preferred-color)
;;		 (value red))
;;  (make-instance of ATTRIBUTE
;;		 (att-name preferred-body)
;;		 (value full))
;;  (make-instance of ATTRIBUTE
;;		 (att-name tastiness)
;;		 (value average))
;;  (make-instance of ATTRIBUTE
;;		 (att-name has-sauce)
;;		 (value yes))
;;  (make-instance of ATTRIBUTE
;;		 (att-name sauce)
;;		 (value tomato))
;;  (make-instance of ATTRIBUTE
;;		 (att-name main-component)
;;		 (value meat))
  (set-fact-duplication TRUE)
  (focus CHOOSE-QUALITIES WINES PRINT-RESULTS))

(defrule MAIN::combine-certainties ""
  (declare (salience 100)
           (auto-focus TRUE))
  ?rem1 <- (object (is-a ATTRIBUTE) (att-name ?rel) (value ?val) (certainty ?per1))
  ?rem2 <- (object (is-a ATTRIBUTE) (att-name ?rel) (value ?val) (certainty ?per2))
  (test (neq ?rem1 ?rem2))
  =>
  (unmake-instance ?rem1)
  (modify-instance ?rem2 (certainty (/ (- (* 100 (+ ?per1 ?per2)) (* ?per1 ?per2)) 100))))
  
;;******************
;; The RULES module
;;******************

(defmodule RULES
  (import MAIN ?ALL)
  (import WebCLIPSHTML deffunction ?ALL)
  (import WebCLIPSTemplates deftemplate ?ALL)
  (export ?ALL))

(defclass RULES::RULE
  (is-a USER)
  (role concrete)
  (pattern-match reactive)
  (slot certainty
	(default 100.0)
	(create-accessor read-write))
  (multislot if
	(create-accessor read-write))
  (multislot then
	(create-accessor read-write)))

(defrule RULES::throw-away-ands-in-antecedent
  ?f <- (object (is-a RULE) (if and $?rest))
  =>
  (modify-instance ?f (if ?rest)))

(defrule RULES::throw-away-ands-in-consequent
  ?f <- (object (is-a RULE) (then and $?rest))
  =>
  (modify-instance ?f (then ?rest)))

(defrule RULES::remove-is-condition-when-satisfied
  ?f <- (object (is-a RULE)
		(certainty ?c1) 
		(if ?attribute is ?value $?rest))
  (object (is-a ATTRIBUTE)
		 (att-name ?attribute) 
		 (value ?value) 
		 (certainty ?c2))
  =>
  (modify-instance ?f (certainty (min ?c1 ?c2)) (if ?rest)))

(defrule RULES::remove-is-not-condition-when-satisfied
  ?f <- (object (is-a RULE)
		(certainty ?c1) 
		(if ?attribute is-not ?value $?rest))
  (object (is-a ATTRIBUTE)
		 (att-name ?attribute)
		 (value ~?value)
		 (certainty ?c2))
  =>
  (modify-instance ?f (certainty (min ?c1 ?c2)) (if ?rest)))

(defrule RULES::perform-rule-consequent-with-certainty
  ?f <- (object (is-a RULE) (certainty ?c1) 
              (if) 
              (then ?attribute is ?value with certainty ?c2 $?rest))
  =>
  (modify-instance ?f (then ?rest))
  (make-instance of ATTRIBUTE
		 (att-name ?attribute) 
		 (value ?value)
		 (certainty (/ (* ?c1 ?c2) 100))))

(defrule RULES::perform-rule-consequent-without-certainty
  ?f <- (object (is-a RULE) (certainty ?c1)
              (if)
              (then ?attribute is ?value $?rest))
  (test (or (eq (length$ ?rest) 0)
            (neq (nth 1 ?rest) with)))
  =>
  (modify-instance ?f (then ?rest))
  (make-instance of ATTRIBUTE
		 (att-name ?attribute)
		 (value ?value)
		 (certainty ?c1)))

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

(defmodule CHOOSE-QUALITIES
  (import RULES ?ALL)
  (import MAIN ?ALL)
  (import WebCLIPSHTML deffunction ?ALL)
  (import WebCLIPSTemplates deftemplate ?ALL))

(defrule CHOOSE-QUALITIES::startit => (focus RULES))

(definstances the-wine-rules
  ; Rules for selecting the best body

  (body1 of RULE (if has-sauce is yes and 
		     sauce is spicy)
	 (then best-body is full))

  (body2 of RULE (if tastiness is delicate)
	 (then best-body is light))

  (body3 of RULE (if tastiness is average)
	 (then best-body is light with certainty 30 and
	       best-body is medium with certainty 60 and
	       best-body is full with certainty 30))

  (body4 of RULE (if tastiness is strong)
	 (then best-body is medium with certainty 40 and
	       best-body is full with certainty 80))

  (body5 of RULE (if has-sauce is yes and
		     sauce is cream)
	 (then best-body is medium with certainty 40 and
	       best-body is full with certainty 60))

  (body6 of RULE (if has-sauce is yes and
		     sauce is tomato)
	 (then best-body is medium with certainty 40 and
	       best-body is full with certainty 80))

  (body7 of RULE (if preferred-body is full)
	 (then best-body is full with certainty 40))

  (body8 of RULE (if preferred-body is medium)
	 (then best-body is medium with certainty 40))

  (body9 of RULE (if preferred-body is light) 
	 (then best-body is light with certainty 40))

  (body10 of RULE (if preferred-body is light and
		      best-body is full)
	  (then best-body is medium))

  (body11 of RULE (if preferred-body is full and
		      best-body is light)
	  (then best-body is medium))

  (body12 of RULE (if preferred-body is unknown) 
	  (then best-body is light with certainty 20 and
		best-body is medium with certainty 20 and
		best-body is full with certainty 20))

  ; Rules for selecting the best color

  (color1 of RULE (if main-component is meat)
	  (then best-color is red with certainty 90))

  (color2 of RULE (if main-component is poultry and
		      has-turkey is no)
	  (then best-color is white with certainty 90 and
		best-color is red with certainty 30))

  (color3 of RULE (if main-component is poultry and
		      has-turkey is yes)
	  (then best-color is red with certainty 90 and
		best-color is white with certainty 30))

  (color4 of RULE (if main-component is fish)
	  (then best-color is white))

  (color5 of RULE (if main-component is-not fish and
		      has-sauce is yes and
		      sauce is tomato)
	  (then best-color is red))

  (color6 of RULE (if has-sauce is yes and
		      sauce is cream)
	  (then best-color is white with certainty 80))
                   
  (color7 of RULE (if preferred-color is red)
	  (then best-color is red with certainty 40))

  (color8 of RULE (if preferred-color is white)
	  (then best-color is white with certainty 40))

  (color9 of RULE (if preferred-color is unknown)
	  (then best-color is red with certainty 20 and
		best-color is white with certainty 20))
  
  ; Rules for selecting the best sweetness

  (sweetness1 of RULE (if has-sauce is yes and
			  sauce is sweet)
	      (then best-sweetness is sweet with certainty 90 and
		    best-sweetness is medium with certainty 40))

  (sweetness2 of RULE (if preferred-sweetness is dry)
	      (then best-sweetness is dry with certainty 40))

  (sweetness3 of RULE (if preferred-sweetness is medium)
	      (then best-sweetness is medium with certainty 40))

  (sweetness4 of RULE (if preferred-sweetness is sweet)
	      (then best-sweetness is sweet with certainty 40))

  (sweetness5 of RULE (if best-sweetness is sweet and
			  preferred-sweetness is dry)
	      (then best-sweetness is medium))

  (sweetness6 of RULE (if best-sweetness is dry and
			  preferred-sweetness is sweet) 
	      (then best-sweetness is medium))

  (sweetness7 of RULE (if preferred-sweetness is unknown)
	      (then best-sweetness is dry with certainty 20 and
		    best-sweetness is medium with certainty 20 and
		    best-sweetness is sweet with certainty 20))

  ; Rules for selecting the best astringency

  (astringency1 of RULE (if has-sauce is yes and 
			    sauce is spicy)
		(then best-astringency is medium with certainty 60 and
		      best-astringency is high with certainty 20))

  (astringency2 of RULE (if has-sauce is yes and
			    sauce is tomato)
		(then best-astringency is high with certainty 80 and
		      best-astringency is medium with certainty 40))

  (astringency3 of RULE (if has-sauce is yes and
			    sauce is cream)
		(then best-astringency is medium with certainty 40))

  (astringency4 of RULE (if has-sauce is yes and
			    sauce is sweet)
		(then best-astringency is low with certainty 80))

  (astringency5 of RULE (if has-sauce is no and
			    main-component is meat)
		(then best-astringency is high with certainty 80 and
		      best-astringency is medium with certainty 40))

  (astringency6 of RULE (if has-sauce is no and
			    main-component is-not meat)
		(then best-astringency is low with certainty 80)))

(defmodule WINES
  (import MAIN ?ALL)
  (import WebCLIPSHTML deffunction ?ALL)
  (import WebCLIPSTemplates deftemplate ?ALL))

(definstances any-attributes
  (best-color of ATTRIBUTE (att-name best-color) (value any))
  (best-body of ATTRIBUTE (att-name best-body) (value any))
  (best-sweetness of ATTRIBUTE (att-name best-sweetness) (value any))
  (best-astringency of ATTRIBUTE (att-name best-astringency) (value any)))

(defclass WINES::WINE
  (is-a USER)
  (role concrete)
  (slot color
	(access initialize-only)
	(storage local)
	(create-accessor read-write))
  (slot body
	(access initialize-only)
	(storage local)
	(create-accessor read-write))
  (slot sweetness
	(access initialize-only)
	(storage local)
	(create-accessor read-write))
  (slot astringency
	(access initialize-only)
	(storage local)
	(create-accessor read-write)))

;; Add, modify, delete wine list here.
;; "And if anybody orders a Merlot..."
;;
(definstances WINES::THE_WINES
  (Gamay of WINE
	 (color red)
	 (body medium)
	 (sweetness medium)
	 (astringency low))
  (Chablis of WINE
	 (color white)
	 (body light)
	 (sweetness dry)
	 (astringency low))
  (Sauvignon-Blanc of WINE
	 (color white)
	 (body medium)
	 (sweetness dry)
	 (astringency low))
  (Chardonnay of WINE
	 (color white)
	 (body full)
	 (sweetness medium)
	 (astringency medium))
  (Soave of WINE
	 (color white)
	 (body medium)
	 (sweetness medium)
	 (astringency low))
  (Reisling of WINE
	 (color white)
	 (body medium)
	 (sweetness sweet)
	 (astringency low))
  (Geverztraminer of WINE
	 (color white)
	 (body full)
	 (sweetness sweet)
	 (astringency low))
  (Chenin-Blanc of WINE
	 (color white)
	 (body light)
	 (sweetness medium)
	 (astringency low))
  (Valpolicella of WINE
	 (color red)
	 (body medium)
	 (sweetness dry)
	 (astringency medium))
  (Cabernet-Sauvignon of WINE
	 (color red)
	 (body full)
	 (sweetness dry)
	 (astringency medium))
  (Zinfandel of WINE
	 (color red)
	 (body full)
	 (sweetness medium)
	 (astringency high))
  (Pinot-Noir of WINE
	 (color red)
	 (body medium)
	 (sweetness medium)
	 (astringency medium))
  (Burgundy of WINE
	 (color red)
	 (body full)
	 (sweetness medium)
	 (astringency medium))
  (Chianti of WINE
	 (color red)
	 (body full)
	 (sweetness dry)
	 (astringency high)))

(defrule WINES::generate-wines
  (object (is-a WINE)
	  (name ?name)
	  (color ?c)
	  (body ?b)
	  (sweetness ?s)
	  (astringency ?a))
  (object (is-a ATTRIBUTE) (att-name best-color) (value ?c) (certainty ?certainty-1))
  (object (is-a ATTRIBUTE) (att-name best-body) (value ?b) (certainty ?certainty-2))
  (object (is-a ATTRIBUTE) (att-name best-sweetness) (value ?s) (certainty ?certainty-3))
  (object (is-a ATTRIBUTE) (att-name best-astringency) (value ?a) (certainty ?certainty-4))
  =>
  (make-instance of ATTRIBUTE
		 (att-name wine)
		 (value ?name)
		 (certainty (min ?certainty-1 ?certainty-2 ?certainty-3 ?certainty-4))))

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

(defmodule PRINT-RESULTS
  (import MAIN ?ALL)
  (import WebCLIPSHTML deffunction ?ALL)
  (import WebCLIPSTemplates deftemplate ?ALL))

(defrule PRINT-RESULTS::header ""
  (declare (salience 10))
  =>
  (h2 "SELECTED WINES" align=center)
  (TableStart cellpadding=3 border=3 align=center)
  (TableRow "WINE" "CERTAINTY"))

(defrule PRINT-RESULTS::print-wine ""
  ?rem <- (object (is-a ATTRIBUTE) (att-name wine) (value ?name) (certainty ?per))		  
  (not (object (is-a ATTRIBUTE) (att-name wine) (certainty ?per1&:(> ?per1 ?per))))
  =>
  (unmake-instance ?rem)
  (TableRow ?name ?per))

(defrule PRINT-RESULTS::remove-poor-wine-choices ""
  ?rem <- (object (is-a ATTRIBUTE) (att-name wine) (certainty ?per&:(< ?per 20)))
  =>
  (unmake-instance ?rem)
  (TableEnd))