;;;======================================================
;;; Circuit Input/Output Simplification Expert System
;;;
;;; This program simplifies the boolean decision
;;; table for a circuit consisting of inputs (SOURCES)
;;; and outputs (LEDs).
;;;
;;; The simplification procedure works as follows:
;;; 1) The connections between components of the
;;; circuit are initialized.
;;; 2) The response of the circuit when all SOURCEs
;;; are set to zero is determined.
;;; 3) Source input values are changed one at a time
;;; and the response of the circuit is determined.
;;; All possible input combinations are iterated
;;; through using a gray code (a number representation
;;; system using binary digits in which successive
;;; integers differ by exactly one binary digit).
;;; For example, the gray code for the numbers 0 to 7
;;; is 0 = 000, 1 = 001, 2 = 011, 3 = 010, 4 = 110,
;;; 5 = 111, 6 = 101, 7 = 100. By using a gray code,
;;; only one SOURCE has to be changed at a time to
;;; determine the next response in the decision
;;; table (minimizing execution time).
;;; 4) As responses are determined, a rule checks to
;;; see if any two sets of inputs with the same
;;; response differ if a single input. If so, then
;;; the single input can be replaced with a *
;;; (indicating that it does not matter what the
;;; value of the input is given the other inputs).
;;; For example, if the input 0 1 0 gave a response
;;; of 1 0 and the input 0 0 0 gave the same response,
;;; then the decision table can be simplified by
;;; indicating that 0 * 0 gives a response of 1 0.
;;; 5) Once all responses and simplifications have been
;;; determined, the decision table for the circuit is
;;; printed.
;;;
;;; This example illustrates the use of most of the
;;; constructs available in CLIPS 6.0 and also shows how
;;; COOL can be effectively integrated with rules.
;;; Generic functions are used to connect the components
;;; of the circuit during initialization. Classes,
;;; message-handlers, and deffunctions are used to
;;; determine the response of the circuit to a set of
;;; inputs. Rules, deffunctions, and global variables
;;; are used to control execution, iterate through all
;;; possible input combinations, simplify the boolean
;;; decision tree, and print out the simplified decision
;;; tree.
;;;
;;; CLIPS Version 6.0 Example
;;;
;;; To execute, load this file, load one of the circuit
;;; files (circuit1.clp, circuit2.clp, or circuit3.clp),
;;; reset, and run.
;;;======================================================
;;;***********
;;; DEFCLASSES
;;;***********
(defclass COMPONENT
(is-a USER)
(slot ID# (create-accessor write)))
(defclass NO-OUTPUT
(is-a USER)
(slot number-of-outputs (access read-only)
(default 0)
(create-accessor read)))
(defmessage-handler NO-OUTPUT compute-output ())
(defclass ONE-OUTPUT
(is-a NO-OUTPUT)
(slot number-of-outputs (access read-only)
(default 1)
(create-accessor read))
(slot output-1 (default UNDEFINED) (create-accessor write))
(slot output-1-link (default GROUND) (create-accessor write))
(slot output-1-link-pin (default 1) (create-accessor write)))
(defmessage-handler ONE-OUTPUT put-output-1 after (?value)
(send ?self:output-1-link
(sym-cat put-input- ?self:output-1-link-pin)
?value))
(defclass TWO-OUTPUT
(is-a ONE-OUTPUT)
(slot number-of-outputs (access read-only)
(default 2)
(create-accessor read))
(slot output-2 (default UNDEFINED) (create-accessor write))
(slot output-2-link (default GROUND) (create-accessor write))
(slot output-2-link-pin (default 1) (create-accessor write)))
(defmessage-handler TWO-OUTPUT put-output-1 after (?value)
(send ?self:output-2-link
(sym-cat put-input- ?self:output-2-link-pin)
?value))
(defclass NO-INPUT
(is-a USER)
(slot number-of-inputs (access read-only)
(default 0)
(create-accessor read)))
(defclass ONE-INPUT
(is-a NO-INPUT)
(slot number-of-inputs (access read-only)
(default 1)
(create-accessor read))
(slot input-1 (default UNDEFINED)
(visibility public)
(create-accessor read-write))
(slot input-1-link (default GROUND) (create-accessor write))
(slot input-1-link-pin (default 1) (create-accessor write)))
(defmessage-handler ONE-INPUT put-input-1 after (?value)
(send ?self compute-output))
(defclass TWO-INPUT
(is-a ONE-INPUT)
(slot number-of-inputs (access read-only)
(default 2)
(create-accessor read))
(slot input-2 (default UNDEFINED)
(visibility public)
(create-accessor write))
(slot input-2-link (default GROUND) (create-accessor write))
(slot input-2-link-pin (default 1) (create-accessor write)))
(defmessage-handler TWO-INPUT put-input-2 after (?value)
(send ?self compute-output))
(defclass SOURCE
(is-a NO-INPUT ONE-OUTPUT COMPONENT)
(role concrete)
(slot output-1 (default UNDEFINED) (create-accessor write)))
(defclass SINK
(is-a ONE-INPUT NO-OUTPUT COMPONENT)
(role concrete)
(slot input-1 (default UNDEFINED) (create-accessor read-write)))
;;;*******************
;;; NOT GATE COMPONENT
;;;*******************
(defclass NOT-GATE
(is-a ONE-INPUT ONE-OUTPUT COMPONENT)
(role concrete))
(deffunction not# (?x) (- 1 ?x))
(defmessage-handler NOT-GATE compute-output ()
(if (integerp ?self:input-1) then
(send ?self put-output-1 (not# ?self:input-1))))
;;;*******************
;;; AND GATE COMPONENT
;;;*******************
(defclass AND-GATE
(is-a TWO-INPUT ONE-OUTPUT COMPONENT)
(role concrete))
(deffunction and# (?x ?y)
(if (and (<> ?x 0) (<> ?y 0)) then 1 else 0))
(defmessage-handler AND-GATE compute-output ()
(if (and (integerp ?self:input-1)
(integerp ?self:input-2)) then
(send ?self put-output-1 (and# ?self:input-1 ?self:input-2))))
;;;******************
;;; OR GATE COMPONENT
;;;******************
(defclass OR-GATE
(is-a TWO-INPUT ONE-OUTPUT COMPONENT)
(role concrete))
(deffunction or# (?x ?y)
(if (or (<> ?x 0) (<> ?y 0)) then 1 else 0))
(defmessage-handler OR-GATE compute-output ()
(if (and (integerp ?self:input-1)
(integerp ?self:input-2)) then
(send ?self put-output-1 (or# ?self:input-1 ?self:input-2))))
;;;********************
;;; NAND GATE COMPONENT
;;;********************
(defclass NAND-GATE
(is-a TWO-INPUT ONE-OUTPUT COMPONENT)
(role concrete))
(deffunction nand# (?x ?y)
(if (not (and (<> ?x 0) (<> ?y 0))) then 1 else 0))
(defmessage-handler NAND-GATE compute-output ()
(if (and (integerp ?self:input-1)
(integerp ?self:input-2)) then
(send ?self put-output-1 (nand# ?self:input-1 ?self:input-2))))
;;;*******************
;;; XOR GATE COMPONENT
;;;*******************
(defclass XOR-GATE
(is-a TWO-INPUT ONE-OUTPUT COMPONENT)
(role concrete))
(deffunction xor# (?x ?y)
(if (or (and (= ?x 1) (= ?y 0))
(and (= ?x 0) (= ?y 1))) then 1 else 0))
(defmessage-handler XOR-GATE compute-output ()
(if (and (integerp ?self:input-1)
(integerp ?self:input-2)) then
(send ?self put-output-1 (xor# ?self:input-1 ?self:input-2))))
;;;*******************
;;; SPLITTER COMPONENT
;;;*******************
(defclass SPLITTER
(is-a ONE-INPUT TWO-OUTPUT COMPONENT)
(role concrete))
(defmessage-handler SPLITTER compute-output ()
(if (integerp ?self:input-1) then
(send ?self put-output-1 ?self:input-1)
(send ?self put-output-2 ?self:input-1)))
;;;**************
;;; LED COMPONENT
;;;**************
(defclass LED
(is-a ONE-INPUT NO-OUTPUT COMPONENT)
(role concrete))
;;; Returns the current value of each LED
;;; instance in a multifield value.
(deffunction LED-response ()
(bind ?response (create$))
(do-for-all-instances ((?led LED)) TRUE
(bind ?response (create$ ?response (send ?led get-input-1))))
?response)
;;;***************************
;;; DEFGENERICS AND DEFMETHODS
;;;***************************
(defgeneric connect)
;;; Connects a one output component to a one input component.
(defmethod connect ((?out ONE-OUTPUT) (?in ONE-INPUT))
(send ?out put-output-1-link ?in)
(send ?out put-output-1-link-pin 1)
(send ?in put-input-1-link ?out)
(send ?in put-input-1-link-pin 1))
;;; Connects a one output component to one pin of a two input component.
(defmethod connect ((?out ONE-OUTPUT) (?in TWO-INPUT) (?in-pin INTEGER))
(send ?out put-output-1-link ?in)
(send ?out put-output-1-link-pin ?in-pin)
(send ?in (sym-cat put-input- ?in-pin -link) ?out)
(send ?in (sym-cat put-input- ?in-pin -link-pin) 1))
;;; Connects one pin of a two output component to a one input component.
(defmethod connect ((?out TWO-OUTPUT) (?out-pin INTEGER) (?in ONE-INPUT))
(send ?out (sym-cat put-output- ?out-pin -link) ?in)
(send ?out (sym-cat put-output- ?out-pin -link-pin) 1)
(send ?in put-input-1-link ?out)
(send ?in put-input-1-link-pin ?out-pin))
;;; Connects one pin of a two output component
;;; to one pin of a two input component.
(defmethod connect ((?out TWO-OUTPUT) (?out-pin INTEGER)
(?in TWO-INPUT) (?in-pin INTEGER))
(send ?out (sym-cat put-output- ?out-pin -link) ?in)
(send ?out (sym-cat put-output- ?out-pin -link-pin) ?in-pin)
(send ?in (sym-cat put-input- ?in-pin -link) ?out)
(send ?in (sym-cat put-input- ?in-pin -link-pin) ?out-pin))
;;;****************************
;;; DEFGLOBALS AND DEFFUNCTIONS
;;;****************************
(defglobal ?*gray-code* = (create$)
?*sources* = (create$)
?*max-iterations* = 0)
;;; Given the current iteration, determines the next
;;; bit in the gray code to change.
;;; Algorithm courtesy of John R. Kennedy (The BitMan).
(deffunction change-which-bit (?x)
(bind ?i 1)
(while (and (evenp ?x) (<> ?x 0)) do
(bind ?x (div ?x 2))
(bind ?i (+ ?i 1)))
?i)
;;; Forward declaration since the initial configuration
;;; is stored in a separate file.
(deffunction connect-circuit ())
;;;*********
;;; DEFRULES
;;;*********
(defrule startup
=>
;; Initialize the circuit by connecting the components
(connect-circuit)
;; Setup the globals.
(bind ?*sources* (find-all-instances ((?x SOURCE)) TRUE))
(do-for-all-instances ((?x SOURCE)) TRUE
(bind ?*gray-code* (create$ ?*gray-code* 0)))
(bind ?*max-iterations* (round (** 2 (length ?*sources*))))
;; Do the first response.
(assert (current-iteration 0)))
(defrule compute-response-1st-time
?f <- (current-iteration 0)
=>
;; Set all of the sources to zero.
(do-for-all-instances ((?source SOURCE)) TRUE (send ?source put-output-1 0))
;; Determine the initial LED response.
(assert (result ?*gray-code* =(str-implode (LED-response))))
;; Begin the iteration process of looping through the gray code combinations.
(retract ?f)
(assert (current-iteration 1)))
(defrule compute-response-other-times
?f <- (current-iteration ?n&~0&:(< ?n ?*max-iterations*))
=>
;; Change the gray code, saving the changed bit value.
(bind ?pos (change-which-bit ?n))
(bind ?nv (- 1 (nth ?pos ?*gray-code*)))
(bind ?*gray-code* (replace$ ?*gray-code* ?pos ?pos ?nv))
;; Change the single changed source
(send (nth ?pos ?*sources*) put-output-1 ?nv)
;; Determine the LED response to the input.
(assert (result ?*gray-code* =(str-implode (LED-response))))
;; Assert the new iteration fact
(retract ?f)
(assert (current-iteration =(+ ?n 1))))
(defrule merge-responses
(declare (salience 10))
?f1 <- (result $?b ?x $?e ?response)
?f2 <- (result $?b ~?x $?e ?response)
=>
(retract ?f1 ?f2)
(assert (result $?b * $?e ?response)))
(defrule print-header
(declare (salience -10))
=>
(assert (print-results))
(do-for-all-instances ((?x SOURCE)) TRUE (format t " %3s " (sym-cat ?x)))
(printout t " | ")
(do-for-all-instances ((?x LED)) TRUE (format t " %3s " (sym-cat ?x)))
(format t "%n")
(do-for-all-instances ((?x SOURCE)) TRUE (printout t "-----"))
(printout t "-+-")
(do-for-all-instances ((?x LED)) TRUE (printout t "-----"))
(format t "%n"))
(defrule print-result
(print-results)
?f <- (result $?input ?response)
(not (result $?input-2 ?response-2&:(< (str-compare ?response-2 ?response) 0)))
=>
(retract ?f)
;; Print the input from the sources.
(while (neq ?input (create$)) do
(printout t " " (nth 1 ?input) " ")
(bind ?input (rest$ ?input)))
;; Print the output from the LEDs.
(printout t " | ")
(bind ?response (str-explode ?response))
(while (neq ?response (create$)) do
(printout t " " (nth 1 ?response) " ")
(bind ?response (rest$ ?response)))
(printout t crlf))
