<![CDATA[;-----------------------------------------------------------------------------------------
; General Heuristic Search
;
; (depth ?) -- Keeps Track of the Level
; (nodes ?) -- The number of Nodes
; (heuristic ?) -- The current value of the heuristic
;
; Method:
; Only those rules fire which have the same heuristic as:
; (heuristic ?)
; After each rule creates a new fact:
; The node count is incremented
; The heuristic value is calculated
; (heuristic ?) is updated (only if the new fact has a greater heuristic)
;
;-------------------------------------------------------------
; Use of Salience:
; Rules: 500
; To be checked or fired after each new node
; Increment-Node-Count 700
; update-heuristic-value 600
; eliminate-illegal 600
; top=-heuristic 600
; After a node has been expanded
; goal-found 450
; get-best-rule-to-expand 400
; Done with all the nodes with current heuristic
; finished 160
; increment-heuristic 150
; update-depth 100
; As soon as a Solution is found: print path
; Done 2000
; Complete 2000
; Done-Complete 2000
;-------------------------------------------------------------
; The status of the water in the water-jug
; State: water-jug The amount of water in the jug
; Search Info: closed Element on Closed List (t)
; depth Depth in tree
; node The number of the node
; parent The address of the parent
; operation The Operation String (for printing)
; Heuristic Info heuristic The heuristic of this node
;
(deftemplate status
(slot water-jug
(type INTEGER)
(default 0)
(range 0 5))
(slot closed
(type INTEGER)
(default 0)
(range 0 1))
(slot heuristic
(type INTEGER)
(default 0))
(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 Heuristic Function
;
(deffunction calculate-heuristic (?amount ?node ?depth)
(if (> ?amount 3) then
-1
else
(- 4 ?amount)))
;-------------------------------------------------------------
; The initial Status
; The heuristic is set low
; Depth is zero
; Node is zero
; Water Jug has no water in it
(defrule Initial-State
?initial <- (initial-fact)
=>
(assert (heuristic 1))
(assert (depth 0 0))
(assert (status (water-jug 0)
(depth 0)
(node 0)
(heuristic 0)
(parent no-parent)))
(assert (nodes 1))
)
;-------------------------------------------------------------
;-------------------------------------------------------------
; The Rules to Create New Facts
;-------------------------------------------------------------
;-------------------------------------------------------------
;-------------------------------------------------------------
; Rule for Adding One Gallon to Water Jug
;
(defrule Add-One-Gallon
(declare (salience 500))
?status <- (status
(closed ?closed)
(water-jug ?amount)
(depth ?depth))
(test (= ?closed 1))
=>
(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
(closed ?closed)
(water-jug ?amount)
(depth ?depth))
(test (= ?closed 1))
=>
(assert (status (water-jug (+ ?amount 2))
(depth (+ ?depth 1))
(parent ?status)
(operation "Add Two Gallons")
))
)
;-------------------------------------------------------------
; After a new node (fact) is created, these can be
; activated
;-------------------------------------------------------------
;-------------------------------------------------------------
; A new fact is created and it is assigned a node number
; The node number is then incremented
;
(defrule Increment-Node-Count
(declare (salience 700))
?status <- (status (node ?statusnode))
?nodes <- (nodes ?nodecount)
(test (= ?statusnode 0))
=>
(assert (nodes (+ 1 ?nodecount)))
(modify ?status (node ?nodecount))
(retract ?nodes)
)
;-------------------------------------------------------------
; If the heuristic of the node says it will not lead to a
; solution, then retract it
(defrule eliminate-illegal
(declare (salience 600))
?node <- (status (heuristic ?value))
(test (< ?value 0))
=>
(retract ?node))
;-------------------------------------------------------------
; If a node was created that was better than the
; current heuristic, then update it to this value
(defrule top-heuristic
(declare (salience 600))
?current <- (heuristic ?currentvalue)
?node <- (status (heuristic ?nodevalue) (closed ?closed))
(test (= 0 ?closed))
(test (< ?nodevalue ?currentvalue))
=>
(retract ?current)
(assert (heuristic ?nodevalue)))
;-------------------------------------------------------------
; Rules to govern the selection of new rules to expand
; The salience is such that they are fired after all
; node (facts) from a given node have been created
;-------------------------------------------------------------
;-------------------------------------------------------------
; Start Expansion of a Fact to produce new nodes
;-------------------------------------------------------------
; This moves the rule which has the same value as the
; heuristic to the CLOSED list (i.e. closed set to 1)
; The initial firing activates in usage in the rules
;
(defrule get-best-rule-to-expand
(declare (salience 400))
?status <- (status (closed ?closed)
(heuristic ?value))
(heuristic ?heuristic)
(test (= 0 ?closed))
(test (= ?heuristic ?value))
=>
(modify ?status (closed 1)))
;-------------------------------------------------------------
; 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 goal-found
(declare (salience 450))
?status <- (status
(heuristic ?heuristic)
(water-jug 3))
(test (> ?heuristic 0))
=>
(modify ?status (heuristic -1000)))
;-------------------------------------------------------------
;
;-------------------------------------------------------------
;-------------------------------------------------------------
; Finished is defined when the cost exceeds a given number
(defrule finished
(declare (salience 160))
(heuristic ?heuristic)
(test (> ?heuristic 10))
(nodes ?nodes)
=>
(printout t "A Total of " (- ?nodes 1) " Nodes in the Tree" crlf)
(halt)
)
;-------------------------------------------------------------
; We are not done, but all nodes of current heuristic value
; have been expanded:
; Find a heuristic value where facts match
(defrule increment-heuristic
(declare (salience 150))
?current <- (heuristic ?currentvalue)
=>
(retract ?current)
(assert (heuristic (+ ?currentvalue 1))))
;-------------------------------------------------------------
; 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))
)
;-------------------------------------------------------------
; Sequence to print out solution
;-------------------------------------------------------------
;-------------------------------------------------------------
; When a goal is found, its heuristic is set to -1000
; this starts the printout loop
(defrule Done
(declare (salience 2000))
?status <- (status (heuristic ?heuristic))
(test (= ?heuristic -1000))
=>
(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)
(nodes ?nodecount)
=>
(printout t "After " (- ?nodecount 1) " nodes; Solution:" crlf ?moves crlf)
(retract ?complete ?old-list))
]]>