;*********************************************************************
;* Author: B. Alex Bridges *
;* File: lab05.clp *
;* Class: ECE-492, Winter 2000 *
;* Project: Lab Assignment 5 - Expert System Using Certainty Theory *
;* Description: This program will help a company choose a vendor *
;* based on various criteria. *
;*********************************************************************
; --TEMPLATES--
( deftemplate vendor
(slot name)
(slot bonded)
(slot licensed)
(slot legal_reqs)
(slot des_exp)
(slot prod_exp)
(slot exp)
(slot insured)
(slot qual1)
(slot refs)
(slot well-reputed)
(slot qual2)
(slot qual1+2)
(slot bid_near_min)
(slot norm_bid)
(slot good_bid)
(slot suitable1)
(slot suitable2)
(slot suitable1+2)
(slot selected (default -1000)) )
; --FACTS--
; none
; --RULES--
; => INITIAL SETUP
( defrule start
(initial-fact)
=>
(assert (stage questions))
(assert (question 1))
(assert (max -1000)) )
; => QUESTIONS AND ANSWERS
( defrule question+answer1 "Vendor's Name"
?x <- (question ?n)
(test (= ?n 1))
?z <- (stage questions)
=>
(printout t crlf "What is the name of the vendor? ")
(bind ?input (readline))
;(printout t crlf " You answered: '" ?input "'" crlf) ;DEBUG
(assert (vendor (name ?input)))
(printout t "On a scale of -1 to +1 or -100 to +100:" crlf)
(retract ?x)
(assert (question =(+ ?n 1))) )
( defrule question+answer2 "Vendor's Criteria: Bonded"
?x <- (question ?n)
(test (= ?n 2))
?y <- (vendor (name ?name) (bonded nil))
?z <- (stage questions)
=>
(printout t "* Is the vendor bonded? ")
(bind ?input (read))
;(printout t crlf " You answered: '" ?input "'" crlf) ;DEBUG
(retract ?x)
( if (not (numberp ?input)) then
(printout t crlf " ERROR: Expected a number for input. Please try again." crlf)
(assert (question ?n)) )
else ( if (>= 1 (abs ?input)) then ;VERIFY VALUE IS [-1,+1]
;(printout t crlf " NOT Adjusting bonded value for '" ?name "'." crlf) ;DEBUG
(modify ?y (bonded ?input))
(assert (question =(+ ?n 1))) )
else ( if (and (< 1 (abs ?input)) (>= 100 (abs ?input))) then ;VERIFY VALUE IS [-100,+100]
;(printout t crlf " Adjusting bonded value for '" ?name "'." crlf) ;DEBUG
(modify ?y (bonded =(/ ?input 100))) ;ADJUST VALUE TO [-1,+1]
(assert (question =(+ ?n 1))) )
else ( if (< 100 (abs ?input)) then
(printout t crlf "ERROR: Number is outside of expected range. Please try again." crlf)
(assert (question ?n)) ) )
( defrule question+answer3 "Vendor's Criteria: Valid License"
?x <- (question ?n)
(test (= ?n 3))
?y <- (vendor (name ?name) (licensed nil))
?z <- (stage questions)
=>
(printout t "* Does the vendor have a valid license? ")
(bind ?input (read))
;(printout t crlf " You answered: '" ?input "'" crlf) ;DEBUG
(retract ?x)
( if (not (numberp ?input)) then
(printout t crlf " ERROR: Expected a number for input. Please try again." crlf)
(assert (question ?n)) )
else ( if (>= 1 (abs ?input)) then ;VERIFY VALUE IS [-1,+1]
;(printout t crlf " NOT adjusting licensed value for '" ?name "'." crlf) ;DEBUG
(modify ?y (licensed ?input))
(assert (question =(+ ?n 1))) )
else ( if (and (< 1 (abs ?input)) (>= 100 (abs ?input))) then ;VERIFY VALUE IS [-100,+100]
;(printout t crlf " adjusting licensed value for '" ?name "'." crlf) ;DEBUG
(modify ?y (licensed =(/ ?input 100))) ;ADJUST VALUE TO [-1,+1]
(assert (question =(+ ?n 1))) )
else ( if (< 100 (abs ?input)) then
(printout t crlf "ERROR: Number is outside of expected range. Please try again." crlf)
(assert (question ?n)) ) )
( defrule question+answer4 "Vendor's Criteria: Design Experience"
?x <- (question ?n)
(test (= ?n 4))
?y <- (vendor (name ?name) (des_exp nil))
?z <- (stage questions)
=>
(printout t "* Does the vendor have design experience? ")
(bind ?input (read))
;(printout t crlf " You answered: '" ?input "'" crlf) ;DEBUG
(retract ?x)
( if (not (numberp ?input)) then
(printout t crlf " ERROR: Expected a number for input. Please try again." crlf)
(assert (question ?n)) )
else ( if (>= 1 (abs ?input)) then ;VERIFY VALUE IS [-1,+1]
;(printout t crlf " NOT adjusting design exp. value for '" ?name "'." crlf) ;DEBUG
(modify ?y (des_exp ?input))
(assert (question =(+ ?n 1))) )
else ( if (and (< 1 (abs ?input)) (>= 100 (abs ?input))) then ;VERIFY VALUE IS [-100,+100]
;(printout t crlf " adjusting design exp. value for '" ?name "'." crlf) ;DEBUG
(modify ?y (des_exp =(/ ?input 100))) ;ADJUST VALUE TO [-1,+1]
(assert (question =(+ ?n 1))) )
else ( if (< 100 (abs ?input)) then
(printout t crlf "ERROR: Number is outside of expected range. Please try again." crlf)
(assert (question ?n)) ) )
( defrule question+answer5 "Vendor's Criteria: Production Experience"
?x <- (question ?n)
(test (= ?n 5))
?y <- (vendor (name ?name) (prod_exp nil))
?z <- (stage questions)
=>
(printout t "* Does the vendor have production experience? ")
(bind ?input (read))
;(printout t crlf " You answered: '" ?input "'" crlf) ;DEBUG
(retract ?x)
( if (not (numberp ?input)) then
(printout t crlf " ERROR: Expected a number for input. Please try again." crlf)
(assert (question ?n)) )
else ( if (>= 1 (abs ?input)) then ;VERIFY VALUE IS [-1,+1]
;(printout t crlf " NOT adjusting production exp. for '" ?name "'." crlf) ;DEBUG
(modify ?y (prod_exp ?input))
(assert (question =(+ ?n 1))) )
else ( if (and (< 1 (abs ?input)) (>= 100 (abs ?input))) then ;VERIFY VALUE IS [-100,+100]
;(printout t crlf " adjusting production exp. value for '" ?name "'." crlf) ;DEBUG
(modify ?y (prod_exp =(/ ?input 100))) ;ADJUST VALUE TO [-1,+1]
(assert (question =(+ ?n 1))) )
else ( if (< 100 (abs ?input)) then
(printout t crlf "ERROR: Number is outside of expected range. Please try again." crlf)
(assert (question ?n)) ) )
( defrule question+answer6 "Vendor's Criteria: Well Insured"
?x <- (question ?n)
(test (= ?n 6))
?y <- (vendor (name ?name) (insured nil))
?z <- (stage questions)
=>
(printout t "* Is the vendor well insured? ")
(bind ?input (read))
;(printout t crlf " You answered: '" ?input "'" crlf) ;DEBUG
(retract ?x)
( if (not (numberp ?input)) then
(printout t crlf " ERROR: Expected a number for input. Please try again." crlf)
(assert (question ?n)) )
else ( if (>= 1 (abs ?input)) then ;VERIFY VALUE IS [-1,+1]
;(printout t crlf " NOT adjusting insured for '" ?name "'." crlf) ;DEBUG
(modify ?y (insured ?input))
(assert (question =(+ ?n 1))) )
else ( if (and (< 1 (abs ?input)) (>= 100 (abs ?input))) then ;VERIFY VALUE IS [-100,+100]
;(printout t crlf " adjusting insured value for '" ?name "'." crlf) ;DEBUG
(modify ?y (insured =(/ ?input 100))) ;ADJUST VALUE TO [-1,+1]
(assert (question =(+ ?n 1))) )
else ( if (< 100 (abs ?input)) then
(printout t crlf "ERROR: Number is outside of expected range. Please try again." crlf)
(assert (question ?n)) ) )
( defrule question+answer7 "Vendor's Criteria: Good References"
?x <- (question ?n)
(test (= ?n 7))
?y <- (vendor (name ?name) (refs nil))
?z <- (stage questions)
=>
(printout t "* Does the vendor have good references? ")
(bind ?input (read))
;(printout t crlf " You answered: '" ?input "'" crlf) ;DEBUG
(retract ?x)
( if (not (numberp ?input)) then
(printout t crlf " ERROR: Expected a number for input. Please try again." crlf)
(assert (question ?n)) )
else ( if (>= 1 (abs ?input)) then ;VERIFY VALUE IS [-1,+1]
;(printout t crlf " NOT adjusting refernces value for '" ?name "'." crlf) ;DEBUG
(modify ?y (refs ?input))
(assert (question =(+ ?n 1))) )
else ( if (and (< 1 (abs ?input)) (>= 100 (abs ?input))) then ;VERIFY VALUE IS [-100,+100]
;(printout t crlf " adjusting references value for '" ?name "'." crlf) ;DEBUG
(modify ?y (refs =(/ ?input 100))) ;ADJUST VALUE TO [-1,+1]
(assert (question =(+ ?n 1))) )
else ( if (< 100 (abs ?input)) then
(printout t crlf "ERROR: Number is outside of expected range. Please try again." crlf)
(assert (question ?n)) ) )
( defrule question+answer8 "Vendor's Criteria: Well-Reputed"
?x <- (question ?n)
(test (= ?n 8))
?y <- (vendor (name ?name) (well-reputed nil))
?z <- (stage questions)
=>
(printout t "* Is the vendor well-reputed? ")
(bind ?input (read))
;(printout t crlf " You answered: '" ?input "'" crlf) ;DEBUG
(retract ?x)
( if (not (numberp ?input)) then
(printout t crlf " ERROR: Expected a number for input. Please try again." crlf)
(assert (question ?n)) )
else ( if (>= 1 (abs ?input)) then ;VERIFY VALUE IS [-1,+1]
;(printout t crlf " NOT adjusting well-reputed value for '" ?name "'." crlf) ;DEBUG
(modify ?y (well-reputed ?input))
(assert (question =(+ ?n 1))) )
else ( if (and (< 1 (abs ?input)) (>= 100 (abs ?input))) then ;VERIFY VALUE IS [-100,+100]
;(printout t crlf " adjusting well-reputed value for '" ?name "'." crlf) ;DEBUG
(modify ?y (well-reputed =(/ ?input 100))) ;ADJUST VALUE TO [-1,+1]
(assert (question =(+ ?n 1))) )
else ( if (< 100 (abs ?input)) then
(printout t crlf "ERROR: Number is outside of expected range. Please try again." crlf)
(assert (question ?n)) ) )
( defrule question+answer9 "Vendor's Criteria: Bid Close To Minimum Bid"
?x <- (question ?n)
(test (= ?n 9))
?y <- (vendor (name ?name) (bid_near_min nil))
?z <- (stage questions)
=>
(printout t "* Is the vendor's bid close to the minimum bid? ")
(bind ?input (read))
;(printout t crlf " You answered: '" ?input "'" crlf) ;DEBUG
(retract ?x)
( if (not (numberp ?input)) then
(printout t crlf " ERROR: Expected a number for input. Please try again." crlf)
(assert (question ?n)) )
else ( if (>= 1 (abs ?input)) then ;VERIFY VALUE IS [-1,+1]
;(printout t crlf " NOT adjusting bid near min. value for '" ?name "'." crlf) ;DEBUG
(modify ?y (bid_near_min ?input))
(assert (question =(+ ?n 1))) )
else ( if (and (< 1 (abs ?input)) (>= 100 (abs ?input))) then ;VERIFY VALUE IS [-100,+100]
;(printout t crlf " adjusting bid near min. value for '" ?name "'." crlf) ;DEBUG
(modify ?y (bid_near_min =(/ ?input 100))) ;ADJUST VALUE TO [-1,+1]
(assert (question =(+ ?n 1))) )
else ( if (< 100 (abs ?input)) then
(printout t crlf "ERROR: Number is outside of expected range. Please try again." crlf)
(assert (question ?n)) ) )
( defrule question+answer10 "Vendor's Criteria: Bid Not Unusual"
?x <- (question ?n)
(test (= ?n 10))
?y <- (vendor (name ?name) (norm_bid nil))
?z <- (stage questions)
=>
(printout t "* Is the vendor's bid not unusual? ")
(bind ?input (read))
;(printout t crlf " You answered: '" ?input "'" crlf) ;DEBUG
(retract ?x)
( if (not (numberp ?input)) then
(printout t crlf " ERROR: Expected a number for input. Please try again." crlf)
(assert (question ?n)) )
else ( if (>= 1 (abs ?input)) then ;VERIFY VALUE IS [-1,+1]
;(printout t crlf " NOT adjusting normal bid value for '" ?name "'." crlf) ;DEBUG
(modify ?y (norm_bid ?input))
(assert (question =(+ ?n 1))) )
else ( if (and (< 1 (abs ?input)) (>= 100 (abs ?input))) then ;VERIFY VALUE IS [-100,+100]
;(printout t crlf " adjusting normal bid value for '" ?name "'." crlf) ;DEBUG
(modify ?y (norm_bid =(/ ?input 100))) ;ADJUST VALUE TO [-1,+1]
(assert (question =(+ ?n 1))) )
else ( if (< 100 (abs ?input)) then
(printout t crlf "ERROR: Number is outside of expected range. Please try again." crlf)
(assert (question ?n)) ) )
( defrule question+answer11 "Repeat Q+A for Additional Vendors"
?x <- (question ?n)
(test (= ?n 11))
?z <- (stage questions)
=>
(printout t crlf "Do you wish to enter additional vendors? ")
(bind ?input (read))
;(bind ?input (lowcase ?input))
;(printout t crlf " You answered: '" ?input "'" crlf) ;DEBUG
(retract ?x)
( if (not (lexemep ?input)) then
(printout t crlf " ERROR: Expected 'yes' or 'no' for input. Please try again." crlf)
(assert (question ?n)) )
else ( if (and (lexemep ?input) (eq (lowcase ?input) yes)) then
(assert (question 1)) )
else ( if (and (lexemep ?input) (eq (lowcase ?input) no)) then
(retract ?z)
(assert (stage calculations)) )
else ( if (and (lexemep ?input)
(neq (lowcase ?input) yes) (neq (lowcase ?input) no)) then
(printout t crlf " ERROR: Expected 'yes' or 'no' for input. Please try again." crlf)
(assert (question ?n)) ) )
; => RULES USING CERTAINTY THEORY
( defrule rule8 "if X is bonded and has valid license,
then X meets legal requirements
(100)"
?y <- (vendor (name ?name)
(bonded ?value1) (licensed ?value2)
(legal_reqs nil))
?z <- (stage calculations)
=>
(modify ?y (legal_reqs (* 1.00 (min ?value1 ?value2)))) )
( defrule rule7 "if X has design experience and production experience,
then X is experienced
(90)"
?y <- (vendor (name ?name)
(des_exp ?value1) (prod_exp ?value2)
(exp nil))
?z <- (stage calculations)
=>
(modify ?y (exp (* 0.90 (min ?value1 ?value2)))) )
( defrule rule6 "if X is well insured and bonded,
then X is qualified
(90)"
?y <- (vendor (name ?name)
(insured ?value1) (bonded ?value2)
(qual2 nil))
?z <- (stage calculations)
=>
(modify ?y (qual2 (* 0.90 (min ?value1 ?value2)))) )
( defrule rule5 "if X has good references, is well-reputed, and is experienced
then X is qualified
(80)"
?y <- (vendor (name ?name)
(refs ?value1) (well-reputed ?value2) (exp ?value3)
(qual1 nil))
?z <- (stage calculations)
=>
( if (neq ?value3 nil) then
(modify ?y (qual1 (* 0.80 (min ?value1 ?value2 ?value3)))) ) )
( defrule rule5+6 "qual1 + qual2 -> qual1+2"
;(declare (salience -1))
?y <- (vendor (name ?name)
(qual1 ?value1) (qual2 ?value2)
(qual1+2 nil))
?z <- (stage calculations)
=>
( if (and (> ?value1 0) (> ?value2 0)) then ;BOTH > 0
(modify ?y (qual1+2 (+ ?value1 (* ?value2 (- 1 ?value1))))) )
else ( if (or (and (< ?value1 0) (not (< ?value2 0)))
(and (not (< ?value1 0)) (< ?value2 0))) then ;ONE < 0
(modify ?y (qual1+2 (/ (+ ?value1 ?value2)
(- 1 (min (abs ?value1) (abs ?value2)))))) )
else ( if (and (< ?value1 0) (< ?value2 0)) then ;BOTH < 0
(modify ?y (qual1+2 (+ ?value1 (* ?value2 (+ 1 ?value1))))) ) )
( defrule rule4 "if X's bid is close to the minimum bid and the bid is not unusual,
then X submits a good bid
(100)"
?y <- (vendor (name ?name)
(bid_near_min ?value1) (norm_bid ?value2)
(good_bid nil))
?z <- (stage calculations)
=>
(modify ?y (good_bid (* 1.00 (min ?value1 ?value2)))) )
( defrule rule3 "if X submits a good bid,
then X is suitable
(95)"
?y <- (vendor (name ?name)
(good_bid ?value1)
(suitable2 nil))
?z <- (stage calculations)
=>
( if (neq ?value1 nil) then
(modify ?y (suitable2 (* 0.95 ?value1))) ) )
( defrule rule2 "if X is qualified,
then X is suitable
(90)"
?y <- (vendor (name ?name)
(qual1+2 ?value1)
(suitable1 nil))
?z <- (stage calculations)
=>
( if (neq ?value1 nil) then
(modify ?y (suitable1 (* 0.90 ?value1))) ) )
( defrule rule2+3 "suitable1 + suitable2 -> suitable1+2"
;(declare (salience -1))
?y <- (vendor (name ?name)
(suitable1 ?value1) (suitable2 ?value2)
(suitable1+2 nil))
?z <- (stage calculations)
=>
( if (and (> ?value1 0) (> ?value2 0)) then ;BOTH > 0
(modify ?y (suitable1+2 (+ ?value1 (* ?value2 (- 1 ?value1))))) )
else ( if (or (and (< ?value1 0) (not (< ?value2 0)))
(and (not (< ?value1 0)) (< ?value2 0))) then ;ONE < 0
(modify ?y (suitable1+2 (/ (+ ?value1 ?value2)
(- 1 (min (abs ?value1) (abs ?value2)))))) )
else ( if (and (< ?value1 0) (< ?value2 0)) then ;BOTH < 0
(modify ?y (suitable1+2 (+ ?value1 (* ?value2 (+ 1 ?value1))))) ) )
( defrule rule1 "if X is suitable and meets legal requirements,
then X should be selected
(100)"
?y <- (vendor (name ?name)
(suitable1+2 ?value1)
(licensed ?value2)
(selected -1000))
?z <- (stage calculations)
=>
( if (and (neq ?value1 nil) (neq ?value2 nil)) then
(modify ?y (selected (* 1.00 (min ?value1 ?value2)))) ) )
; => REPORT THE RESULTS
( defrule report "Print the Results"
(declare (salience -5))
?z <- (stage calculations)
=>
(retract ?z)
(assert (stage report))
(printout t crlf "Here is the order in which the vendors should be selected:" crlf) )
( defrule find+printmax "Find and Print the Current Maximum"
(declare (salience -10))
?y <- (vendor (name ?name1) (selected ?value1))
(not (vendor (name ?name2) (selected ?value2&: (> ?value2 ?value1))))
?z <- (stage report)
=>
(retract ?y)
(printout t "* " ?name1 " (CF of " ?value1 ")" crlf) )
;( defrule findmax "Find the Current Maximum"
; (declare (salience -10))
; (vendor (selected ?value1))
; ?r <- (max ?value2)
; (test (> ?value1 ?value2))
; =>
; (retract ?r)
; (assert (max ?value1)) )
;( defrule printmax "Print the Current Maximum"
; (declare (salience -15))
; ?r1 <- (vendor (name ?name) (selected ?value))
; ?r2 <- (max ?value)
; =>
; (retract ?r1 ?r2)
; (printout t "* " ?name " (CF of " ?value ")" crlf)
; (assert (max -1000)) )