B.3 Uncertain Reasoning Facility

Below is the complete code which implements the uncertain reasoning facility of 6.1.1.4 Reasoning with Certainty Factors. The implementation is exactly as described with a few extra considerations to check the rule interpreter is running before returning an uncertain value, that the objects have a certainty-factor slot and so on.

;;; -----SIMPLE REASONING WITH UNCERTAINTY FACTORS ----
 
(in-package kw-user)
 
;;; default certainty factor
(defvar *c-factor* 1)
 
;;; implication strength of a rule
(defvar *implication-strength* 1)
 
(defun default-c-factor ()
  "if the forward chainer is not running, certainty
   factor is just 1"
  (if *in-interpreter*
      (* *implication-strength* *c-factor*)
    1))
 
;;; uncertain objects need a slot to store their
;;; `probability' this slot defaults to the value
;;; returned by default-c-factor
 
(def-kb-class uncertain-kb-object ()
  ((c-factor :initform (default-c-factor)
             :initarg :c-factor)))
 
(defun object-c-factor (obj)
  "if an object has no uncertainty slot, return 1 (i.e.
   certain)"
  (if (slot-exists-p obj `c-factor)
      (slot-value obj `c-factor)
    1))
 
(defun inst-c-factor (inst)
  "the certainty factor of an instantiation"
  (token-c-factor (inst-token inst)))
 
(defun token-c-factor (token)
  "the certainty factor of an ANDed list of objects
   (just multiply them)"
  (reduce `* (mapcar `object-c-factor token)))
 
(defun implication-strength (val)
  "for a rule to set the implication strength"
  (setq *implication-strength* val))
 
;;; this function increases the certainty of the object
;;; which is the first argument by an amount dependent
;;; on the combined certainty of the remaining
;;; arguments
 
(defun add-evidence (obj &rest token)
  "increments the certainty of obj based on the
   certainty of token"
  (let ((c-f (slot-value obj `c-factor)))
    (setf (slot-value obj `c-factor)
          (+ c-f
             (* (- 1 c-f) *implication-strength*     
                (token-c-factor token))))))
 
;;; this tactic is dynamic as the certainty factor slot
;;; gets changed by calling add-evidence
 
(deftactic certainty :dynamic (i1 i2)
  "a conflict resolution tactic to prefer more certain
   instantiations"
  (> (inst-c-factor i1) (inst-c-factor i2)))
 
;;; Before firing a rule this meta-interpreter just
;;; sets the value of *c-factor* to the certainty of
;;; the instantiation so that any new uncertain objects
;;; made get this (times *implication-strength*) as
;;; their certainty. Also sets *implication-strength*
;;; to 1 as a default in case the rule does not set it.
 
(defrule uncertain-context :backward
  ((uncertain-context)
   <--
   (start-cycle)
   (instantiation ?inst)
   ((progn (setq *c-factor* (inst-c-factor ?inst))
      (setq *implication-strength* 1)))
   (fire-rule ?inst)
   (cut)
   (uncertain-context)))

Below are some example rules using this facility for a simple car maintenance problem.

;;; ---------------- SOME EXAMPLE RULES ---------------
;;; to run: (run-diagnose)
 
(def-kb-struct start)
(def-kb-class symptom (uncertain-kb-object)
  ((type :initarg :type)))
(def-kb-class fault (uncertain-kb-object)
  ((type :initarg :type)))
(def-kb-class remedy (uncertain-kb-object)
  ((type :initarg :type)))
 
;;; this context sets up the initial hypotheses and
;;; gathers evidence this does not need the meta
;;; -interpreter as that's only necessary for
;;; transparent assignment of certainty factors to new
;;; objects
 
(defcontext diagnose :strategy ())
 
(defrule start-rule :forward
  :context diagnose
  (start ?s)
  -->
  (assert (symptom ? type over-heat c-factor 1))
  (assert (symptom ? type power-loss c-factor 1))
  (assert (fault ? type lack-of-oil c-factor 0.5))
  (assert (fault ? type lack-of-water c-factor 0))
  (assert (fault ? type battery c-factor 0))
  (assert (fault ? type unknown c-factor 0))
  (context (cure)))
               ; next context onto agenda
 
(defrule diagnose1 :forward
  :context diagnose
  (symptom ?s type over-heat)
  (fault ?f type lack-of-water)
  -->
  ((implication-strength 0.9))
  ((add-evidence ?f ?s)))
 
(defrule diagnose2 :forward
  :context diagnose
  (symptom ?s type overheat)
  (fault ?f type unknown)
  -->
  ((implication-strength 0.1))
  ((add-evidence ?f ?s)))
 
(defrule diagnose3 :forward
  :context diagnose
  (symptom ?s type wont-start)
  (fault ?f type battery)
  -->
  ((implication-strength 0.9))
  ((add-evidence ?f ?s)))
 
(defrule diagnose4 :forward
  :context diagnose
  (symptom ?s type wont-start)
  (fault ?f type unknown)
  -->
  ((implication-strength 0.1))
  ((add-evidence ?f ?s)))
 
(defrule diagnose5 :forward
  :context diagnose
  (symptom ?s type power-loss)
  (fault ?f type lack-of-oil)
  -->
  ((implication-strength 0.9))
  ((add-evidence ?f ?s)))
 
(defrule diagnose6 :forward
  :context diagnose
  (symptom ?s type power-loss)
  (fault ?f type unknown)
  -->
  ((implication-strength 0.1))
  ((add-evidence ?f ?s)))
 
;;; any two distinct symptoms strengthens the
;;; hypothesis that there's something more serious
;;; going wrong
 
(defrule diagnose7 :forward
  :context diagnose
  (symptom ?s1 type ?t1)
  (symptom ?s2 type ?t2)
  (test (not (eq ?t1 ?t2)))
  (fault ?f type unknown)
  -->
  ((add-evidence ?f ?s1 ?s2)))
 
;;; here we need the meta-interpreter to assign the
;;; right certainty factors to the remedy objects. Also
;;; use certainty as a conflict resolution tactic to
;;; print the suggested remedies out in order
 
(defcontext cure :strategy (priority certainty)
                :meta ((uncertain-context)))
 
(defrule cure1 :forward
  :context cure
  (fault ?f type unknown)
  -->
  ((implication-strength 0.1))
  (assert (remedy ? type cross-fingers))
  ((implication-strength 0.9))
  (assert (remedy ? type go-to-garage)))
 
(defrule cure2 :forward
  :context cure
  (fault ?f type lack-of-oil)
  -->
  (assert (remedy ? type add-oil)))
 
(defrule cure3 :forward
  :context cure
  (fault ?f type lack-of-water)
  -->
  (assert (remedy ? type add-water)))
 
(defrule cure4 :forward
  :context cure
  (fault ?f type battery)
  -->
  (assert (remedy ? type new-battery)))
 
(defrule print-cures :forward
  :context cure
  :priority 5
  (remedy ?r type ?t)
  -->
  ((format t "~%Suggest remedy ~a with certainty-factor
             ~a" ?t (slot-value ?r `c-factor))))
 
(defun run-diagnose ()
  (reset)
  (make-instance `start)
  (infer :contexts `(diagnose)))