My knowledgebase is not yet making the conclusions I'm hoping for. In
hopes of determining what additional facts or inference rules I need,
I hacked together a CommonLisp program that reads my '.clp' files and
produces an html file which shows how the rules and fact templates
relate to one another.
I expect that there's probably already similar tools that would
provide the same information (or more) working directly from the Java
Rete instance but I don't know what they are.
Here's my hack, in case anyone's interested. It was develooped using
LispWorks but I expect it should work in any CommonLisp.
;;; -*- Mode:Lisp -*-
(defun index-clp-file (file)
(let ((jess-info (process-jess-clp-file file)))
(html-write jess-info
(make-pathname :type "html" :defaults file))))
(defclass jess-info ()
((fact-names :initform nil)
(rule-names :initform nil)
(facts-to-rules
;; ALIST of (FACT RULE-IT-TRIGGERS)
:initform nil)
(rules-to-facts
;; ALIST of (RULE FACT-IT-ASSERTS)
:initform nil)))
(defmethod note-rule-requires-fact ((ji jess-info)
rule-name fact-name)
(with-slots (fact-names rule-names facts-to-rules) ji
(pushnew fact-name fact-names)
(pushnew rule-name rule-names)
(pushnew (list fact-name rule-name)
facts-to-rules
:test 'equal)))
(defmethod note-rule-asserts-fact ((ji jess-info) rule-name fact-name)
(with-slots (fact-names rule-names rules-to-facts) ji
(pushnew fact-name fact-names)
(pushnew rule-name rule-names)
(pushnew (list rule-name fact-name)
rules-to-facts
:test 'equal)))
(defvar *html-indent* 0)
(defparameter +html-indent-step+ 2)
(defmacro with-tag ((stream tag &rest attributes) &body body)
(let ((tag-var '#:tag)
(stream-var '#:stream))
`(let ((,tag-var ,tag)
(,stream-var ,stream))
(format ,stream-var "~&~vT<~a~{ ~a='~a'~}>"
(* *html-indent* +html-indent-step+)
,tag-var
(list ,@attributes))
(let ((*html-indent* (1+ *html-indent*)))
,@body)
(format , stream-var "~&~vT</~a>"
(* *html-indent* +html-indent-step+)
,tag-var))))
(defmethod html-write ((jess-info jess-info) to)
(html-write jess-info (pathname to)))
(defmethod html-write ((jess-info jess-info) (to pathname))
(with-open-file (stream to
:direction :output
:if-exists :supersede)
(format *trace-output* "~&Outputting to ~a" (pathname stream))
(html-write jess-info stream)))
(defmethod html-write ((jess-info jess-info) (stream stream))
(with-tag (stream "html")
(with-tag (stream "body")
(labels ((make-a-name (what thing)
(ecase what
(:fact (format nil "fact-~a" thing))
(:rule (format nil "rule-~a" thing))))
(do-em (list match-key match-value relationship other-key other-type)
(dolist (item list)
(when (eq match-value (funcall match-key item))
(let ((other (funcall other-key item)))
(with-tag (stream "li")
(format stream "~a " relationship)
(with-tag (stream
"a" "href"
(string-append "#"
(make-a-name other-type
other)))
(format stream "~a" other))))))))
(with-slots (fact-names rule-names facts-to-rules rules-to-facts) jess-info
(setq fact-names (sort fact-names 'string-lessp :key 'symbol-name))
(setq rule-names (sort rule-names 'string-lessp :key 'symbol-name))
(with-tag (stream "dl")
(with-tag (stream "h2")
(write-string "Facts" stream))
(dolist (fact fact-names)
(with-tag (stream "dt")
(with-tag (stream "a" "name" (make-a-name :fact fact))
(format stream "fact ")
(with-tag (stream "b")
(format stream "~a" fact))))
(with-tag (stream "dd")
(do-em facts-to-rules 'first fact "triggers" 'second :rule)
(do-em rules-to-facts 'second fact "asserted by" 'first :rule)))
(with-tag (stream "h2")
(write-string "Rules" stream))
(dolist (rule rule-names)
(with-tag (stream "dt")
(with-tag (stream "a" "name" (make-a-name :rule rule))
(format stream "rule ")
(with-tag (stream "b")
(format stream "~a" rule))))
(with-tag (stream "dd")
(do-em facts-to-rules 'second rule "triggered by" 'first :fact)
(do-em rules-to-facts 'first rule "asserts" 'second :fact)))))))))
(defun process-jess-clp-file (pathname
&optional
(jess-info (make-instance 'jess-info)))
(with-open-file (stream pathname
:direction :input)
(format t "~&Processing ~a" (pathname stream))
(handler-case
(loop
(let ((form (read stream)))
(process-jess-top-level-form jess-info form)))
(end-of-file () )))
jess-info)
(defmethod process-jess-top-level-form ((jess-info jess-info)
(form list))
(process-jess-top-level-expression jess-info (car form) (cdr form)))
(defmethod process-jess-top-level-expression ((jess-info jess-info)
(op symbol) args)
)
(defmethod process-jess-top-level-expression ((jess-info jess-info)
(op (eql 'batch)) args)
(process-jess-clp-file (car args) jess-info))
(defmethod process-jess-top-level-expression ((jess-info jess-info)
(op (eql 'deffacts)) args)
)
(defmethod process-jess-top-level-expression ((jess-info jess-info)
(op (eql 'do-backward-chaining))
args)
(format t "~&Backward chaining: ~a" (car args)))
(defmethod process-jess-top-level-expression ((jess-info jess-info)
(op (eql 'defrule)) args)
(let ((rule-name nil)
(consequent-p :if))
(dolist (f args)
(multiple-value-setq (consequent-p rule-name)
(process-jess-rule-clause jess-info f consequent-p rule-name)))))
(defgeneric process-jess-rule-clause (jess-info clause consequent-p rule-name)
(declare (values new-consequent-p rule-name)))
(defmethod process-jess-rule-clause ((jess-info jess-info)
(clause (eql '<-))
(consequent-p (eql :if))
(rule-name symbol))
;; no-op
(values consequent-p rule-name))
(defmethod process-jess-rule-clause ((jess-info jess-info)
(clause (eql '=>))
(consequent-p (eql :if))
(rule-name symbol))
;; enter consequent mode
(values :then rule-name))
(defmethod process-jess-rule-clause ((jess-info jess-info)
(clause string)
(consequent-p (eql :if))
rule-name)
;; ignore rule doc string
(values consequent-p rule-name))
(defmethod process-jess-rule-clause ((jess-info jess-info)
(clause symbol)
(consequent-p (eql :if))
(rule-name null))
;; got rule name
(values consequent-p clause))
(defmethod process-jess-rule-clause ((jess-info jess-info)
(clause symbol)
consequent-p
(rule-name symbol))
;; no-op
(values consequent-p rule-name))
(defmethod process-jess-rule-clause ((jess-info jess-info)
(clause list)
(consequent-p (eql :if))
(rule-name symbol))
(unless (eq (car clause) 'test)
(note-rule-requires-fact jess-info rule-name (car clause)))
(values consequent-p rule-name))
(defmethod process-jess-rule-clause ((jess-info jess-info)
(clause list)
(consequent-p (eql :then))
(rule-name symbol))
(when (eq (car clause) 'assert)
(dolist (asserted (cdr clause))
(note-rule-asserts-fact jess-info rule-name (car asserted))))
(values consequent-p rule-name))
--------------------------------------------------------------------
To unsubscribe, send the words 'unsubscribe jess-users [EMAIL PROTECTED]'
in the BODY of a message to [EMAIL PROTECTED], NOT to the list
(use your own address!) List problems? Notify [EMAIL PROTECTED]
--------------------------------------------------------------------
