(defmodule OAV (export deftemplate oav))
(deftemplate OAV::oav
(multislot object (type SYMBOL))
(multislot attribute (type SYMBOL))
(multislot value )
(slot CF (type FLOAT) (range -1.0 +1.0)))
(set-fact-duplication TRUE)
(defmethod OAV::combine-certainties
((?CF1 NUMBER (> ?CF1 0)) (?CF2 NUMBER (> ?CF2 0)))
(- (+ ?CF1 ?CF2) (* ?CF1 ?CF2)))
(defrule OAV::combine-certainties
(declare (auto-focus TRUE))
?fact1 <- (oav (object $?o)
(attribute $?a)
(value $?v)
(CF ?C1))
?fact2 <- (oav (object $?o)
(attribute $?a)
(value $?v)
(CF ?C2))
(test (neq ?fact1 ?fact2))
=>
(retract ?fact1)
(modify ?fact2
(CF (combine-certainties ?CF1 ?CF2))))
The following MYCIN rule
IF
The stain of the organism is gramneg and
The morphology of the organism is rod and
The patient is a compromised host
THEN
There is suggestive evidence (0.6) that the
identity of the organism is pseudomonas
can be rewritten in CLIPS:
(defmodule IDENTITY (import OAV deftemplate oav))
(defrule IDENTITY::MYCIN-to-CLIPS-translation
(declare (auto-focus TRUE))
(oav (object organism)
(attribute stain)
(value gramneg)
(CF ?C1))
(oav (object organism)
(attribute morphology)
(value rod)
(CF ?C2))
(oav (object patient)
(attribute is a)
(value compromised host)
(CF ?C3))
(test (> (min ?C1 ?C2 ?C3) 0.2))
=>
(bind ?C4 (* (min ?C1 ?C2 ?C3) 0.6))
(assert (oav (object organism)
(attribute identity)
(value pseudomonas)
(CF ?C4))))
(deftemplate node (slot name) (slot type) (slot question) (slot yes-node) (slot no-node) (slot answer))initialize
(defrule initialize (not (node (name root))) => (load-facts "animal.dat") (assert (current-node root)))ask the question
(deffunction ask-yes-or-no (?question)
(printout t ?question " (yes or no) ")
(bind ?answer (read))
(while (and (neq ?answer yes) (neq ?answer no))
(printout t ?question " (yes or no) ")
(bind ?answer (read)))
(return ?answer))
(defrule ask-decision-node-question
?node <- (current-node ?name)
(node (name ?name)
(type decision)
(question ?question))
(not (answer ?))
=>
(assert (answer (ask-yes-or-no ?question))))
response to the answer
(defrule proceed-to-yes-branch
?node <- (current-node ?name)
(node (name ?name)
(type decision)
(yes-node ?yes-branch))
?answer <- (answer yes)
=>
(retract ?node ?answer)
(assert (current-node ?yes-branch)))
(defrule proceed-to-no-branch
?node <- (current-node ?name)
(node (name ?name)
(type decision)
(no-node ?no-branch))
?answer <- (answer no)
=>
(retract ?node ?answer)
(assert (current-node ?no-branch)))
ask-if-answer-node-is-correct
(defrule ask-if-answer-node-is-correct
?node <- (current-node ?name)
(node (name ?name) (type answer)
(answer ?value))
(not (answer ?))
=>
(printout t "I guess it is a " ?value crlf)
(assert (answer (ask-yes-or-no "Am I correct?"))))
answer-node-guess
(defrule answer-node-guess-is-correct ?node <- (current-node ?name) (node (name ?name) (type answer)) ?answer <- (answer yes) => (retract ?node ?answer)) (defrule answer-node-guess-is-incorrect ?node <- (current-node ?name) (node (name ?name) (type answer)) ?answer <- (answer no) => (assert (replace-answer-node ?name)) (retract ?node ?answer))replace-answer-node
(defrule replace-answer-node
?phase <- (replace-answer-node ?name)
?data <- (node (name ?name)
(type answer)
(answer ?value))
=>
(retract ?phase)
; Determine what the guess should have been
(printout t "What is the animal? ")
(bind ?new-animal (read))
; Get the question for the guess
(printout t "What question when answered yes ")
(printout t "will distinguish " crlf " a ")
(printout t ?new-animal " from a " ?value "? ")
(bind ?question (readline))
(printout t "Now I can guess " ?new-animal crlf)
; Create the new learned nodes
(bind ?newnode1 (gensym*))
(bind ?newnode2 (gensym*))
(modify ?data (type decision)
(question ?question)
(yes-node ?newnode1)
(no-node ?newnode2))
(assert (node (name ?newnode1)
(type answer)
(answer ?new-animal)))
(assert (node (name ?newnode2)
(type answer)
(answer ?value)))
)
(deftemplate BC::rule
(multislot if)
(multislot then))
Each antecedent, <condition>, is either
<attribute> is <value>
or
<attribute> is <value> and <condition>
(deftemplate BC::attribute (slot name) (slot value)) (deftemplate BC::goal (slot attribute))
(defrule BC::attempt-rule
(goal (attribute ?g-name))
(rule (if ?a-name $?)
(then ?g-name $?))
(not (attribute (name ?a-name)))
(not (goal (attribute ?a-name)))
=>
(assert (goal (attribute ?a-name))))
(defrule BC::ask-attribute-value
?goal <- (goal (attribute ?g-name))
(not (attribute (name ?g-name)))
(not (rule (then ?g-name $?)))
=>
(retract ?goal)
(printout t "What is the value of " ?g-name "? ")
(assert (attribute (name ?g-name)
(value (read)))))
(defrule BC::goal-satisfied
(declare (salience 100))
?goal <- (goal (attribute ?g-name))
(attribute (name ?g-name))
=>
(retract ?goal))
(defrule BC::rule-satisfied
(declare (salience 100))
(goal (attribute ?g-name))
(attribute (name ?a-name)
(value ?a-value))
?rule <- (rule (if ?a-name is ?a-value)
(then ?g-name is ?g-value))
=>
(retract ?rule)
(assert (attribute (name ?g-name)
(value ?g-value))))
(defrule BC::remove-rule-no-match
(declare (salience 100))
(goal (attribute ?g-name))
(attribute (name ?a-name) (value ?a-value))
?rule <- (rule (if ?a-name is ~?a-value)
(then ?g-name is ?g-value))
=>
(retract ?rule))
(defrule BC::modify-rule-match
(declare (salience 100))
(goal (attribute ?g-name))
(attribute (name ?a-name) (value ?a-value))
?rule <- (rule (if ?a-name is ?a-value and
$?rest-if)
(then ?g-name is ?g-value))
=>
(retract ?rule)
(modify ?rule (if $?rest-if)))
To select the best color of wine to serve with a meal.
(deffacts MAIN::wine-rules
(rule (if main-course is red-meat)
(then best-color is red))
(rule (if main-course is fish)
(then best-color is white))
(rule (if main-course is poultry and
meal-is-turkey is yes)
(then best-color is red))
(rule (if main-course is poultry and
meal-is-turkey is no)
(then best-color is white)))
(deffacts MAIN::initial-goal
(goal (attribute best-color)))
; The backward chaining demo from chapter 7 of "Jess in Action"
;
(do-backward-chaining factorial)
(defrule print-factorial-10
(factorial 10 ?r1) ; Jess automatically assert (need-factorial 10 nil)
=>
(printout t "The factorial of 10 is " ?r1 crlf))
(defrule do-factorial
(need-factorial ?x ?)
=>
;; compute the factorial of ?x in ?r
(bind ?r 1)
(bind ?n ?x)
(while (> ?n 1)
(bind ?r (* ?r ?n))
(bind ?n (- ?n 1)))
(assert (factorial ?x ?r)))
Jess Demo
(deftemplate question
"A question the application may ask"
(slot text) ;; The question itself
(slot type) ;; Can be multi, text, or numeric
(multislot valid) ;; The allowed answers for type multi
(slot ident)) ;; The "name" of the question
(deftemplate answer
(slot ident)
(slot text))
(do-backward-chaining answer)
(defrule supply-answers
;(declare (auto-focus TRUE))
(need-answer (ident ?id))
(not (answer (ident ?id)))
(not (ask ?))
=>
(assert (ask ?id))
(return))
; encoded rules
(deffacts question-data
(question (ident miles)
(type number) (valid)
(text "How many miles is the theater away?"))
(question (ident minutes)
(type number) (valid)
(text "How many minutes is the show time from now?"))
(question
(ident location) (type multi) (valid yes no)
(text "Is the theater located in downtown?"))
(question
(ident weather-condition) (type multi) (valid bad good)
(text "What is the weather condition?"))
)
(defrule rule1
(answer (ident miles) (text ?d))
(test (>= (integer ?d) 2))
=>
(assert (transportation-means drive)) )
(defrule rule2
(answer (ident miles) (text ?d))
(test (< (integer ?d) 2))
(answer (ident minutes) (text ?t))
(test (<= (integer ?t) 15))
;(theater (miles ?d&:(> ?d 1))
=>
(assert (transportation-means drive)) )
(defrule rule3
(answer (ident miles) (text ?d))
(test (< (integer ?d) 2))
(answer (ident minutes) (text ?t))
(test (> (integer ?t) 15))
=>
(assert (transportation-means walk)) )
(defrule rule4
(transportation-means drive)
(answer (ident location) (text yes))
=>
(assert (suggestion-action "take a cab")) )
(defrule rule5
(transportation-means drive)
(answer (ident location) (text no))
=>
(assert (suggestion-action "drive your car")) )
(defrule rule6
(transportation-means walk)
(answer (ident weather-condition) (text bad))
=>
(assert (suggestion-action "take a coat and walk")) )
(defrule rule7
(transportation-means walk)
(answer (ident weather-condition) (text good))
=>
(assert (suggestion-action walk)) )
Previous Efficiency in Rule-based Languages Up TOC