;********************************************************************* ;* 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)) )