<![CDATA[;-----------------------------------------------------------------------------------------
; This is the second attempt at Breadth First Search For the Water-Jug Problem
;
; (depth ?) -- Keeps Track of the Level
; (nodes ?) -- The number of Nodes
; In the status template fields were added
; node - The node number
; parent - The address of the parent (to be able to see the path)
; operation - An ASCII string for the operation
;
; As Before
; Facts of the current depth are expanded to create facts of the next level.
;
; All facts of the current level are expanded before those of the next level are expanded
; This is done using the routine update-depth, which (because of its lower salience)
; is called after all the facts are evaluated from the agenda. The update-depth
; routine creates a fact with an incremented depth level. This then activates the facts of the
; next depth.
;
;
;-----------------------------------------------------------------------------------------
; The status of the water in the water-jug
;
(deftemplate status
(slot water-jug
(type INTEGER)
(default 0)
(range 0 5))
(slot depth
(type INTEGER)
(default 0))
(slot node
(type INTEGER)
(default 0))
(slot parent
(type FACT-ADDRESS SYMBOL)
(default no-parent)
(allowed-symbols no-parent))
(slot operation
(type STRING))
)
;-----------------------------------------------------------------------------------------
; The initial Status
;;
(defrule Initial-State
?initial <- (initial-fact)
=>
(printout t "The Initial State is an Empty Jug" crlf)
(assert (depth 0 0))
(assert (status (water-jug 0) (depth 0)
(parent no-parent)))
(assert (nodes 1))
)
;-----------------------------------------------------------------------------------------
; Rule for Adding One Gallon to Water Jug
;
(defrule Add-One-Gallon
(declare (salience 500))
?status <- (status
(water-jug ?amount)
(depth ?depth))
(depth ?current ?)
(test (= ?depth ?current))
(test (< ?amount 3))
=>
(assert (status (water-jug (+ ?amount 1))
(depth (+ ?depth 1))
(parent ?status)
(operation "Add One Gallon")
))
)
;-----------------------------------------------------------------------------------------
; Rule for Adding Two Gallons to Water Jug
;
(defrule Add-Two-Gallons
(declare (salience 500))
?status <- (status
(water-jug ?amount)
(depth ?depth))
(depth ?current ?)
(test (= ?depth ?current))
(test (< ?amount 3))
=>
(assert (status (water-jug (+ ?amount 2))
(depth (+ ?depth 1))
(parent ?status)
(operation "Add Two Gallons")
))
)
;-----------------------------------------------------------------------------------------
(defrule Increment-Node-Count
(declare (salience 600))
?status <- (status (node ?statusnode))
?nodes <- (nodes ?nodecount)
(test (= ?statusnode 0))
=>
(assert (nodes (+ 1 ?nodecount)))
(modify ?status (node ?nodecount))
(retract ?nodes)
)
;-----------------------------------------------------------------------------------------
; Rule to update current depth
; Called only if depth is done for all rules for this level
; (hence the lower salience)
;
(defrule update-depth
(declare (salience 100))
?depth <- (depth ?current ?last)
?node <- (nodes ?nodes)
(test (> ?nodes ?last))
=>
(retract ?depth)
(assert (depth (+ 1 ?current) ?nodes))
)
(defrule finished
(declare (salience 100))
?depth <- (depth ?current ?last)
?node <- (nodes ?nodes)
(test (= ?nodes ?last))
=>
(printout t "A Total of " (- ?nodes 1) " Nodes in the Tree" crlf)
(retract ?depth)
(halt)
)
;-----------------------------------------------------------------------------------------
; Rule for Detecting Done with Task (i.e. the jug has 3 gallons in it)
; Put Salience High so when matched, it is the first rule
;
(defrule Done
(declare (salience 1000))
?status <- (status
(water-jug 3)
(operation ?move))
=>
(assert (complete ?status))
(assert (list "Done")))
(defrule Complete
(declare (salience 2000))
?status <- (status (parent ?parent) (operation ?move))
?complete <- (complete ?status)
?old-list <- (list $?rest)
=>
(assert (list ?move ?rest))
(assert (complete ?parent))
(retract ?complete)
(retract ?old-list)
)
(defrule Done-Complete
(declare (salience 2000))
?complete <- (complete no-parent)
?old-list <- (list ?first $?moves ?last)
=>
(printout t "Solution:" crlf ?moves crlf)
(retract ?complete ?old-list))
]]>