;;; Representation for N Jug Problem} ;;; Chris Brown} ;;; generate successors for n-jug problem ;;; For N jugs, state is N+1 long list giving the current contents ;;; of all the jugs. ;;; The zeroth jug is an infinite source and sink of water and is thus ;;; treated a little differently. ;;; But that means there is only ONE operation, "pour from jug1 into jug2", ;;; whose arguments (jug1, jug2) are the operation's description (op-desc). ;;; A node is a triple (3-long list) of ;;; (state, op-desc, parent) ;;; disallow ;;; previously generated states (use hashtable) ;;; filling full jug ;;; pouring from empty jug ;;; try to fill jug from self ;; Here's all you need for a hash function (setf visited (make-hash-table :test #'equal)) (defun not-visited (state) (not (gethash state visited))) (defun mark-visited (state) (setf (gethash state visited) 1)) ;;; initialize some obvious variables: capacities is how big the jugs are ;;; (we want jug0 to have nonzero contents for a test later but we don't care ;;; what its capacity is) (defconstant n 3) (setf capacities '(0 3 5)) (setf init-state '(1 0 0) ) (setf goal-state '(1 0 4)) (setf start-node (list init-state nil nil)) (setf nodes nil) ;;; clearly initial state is going to be visited... (mark-visited init-state) ;;; super-simple accessor functions for our node "structure" (defun state-of (node) (car node)) (defun op-of (node) (cadr node)) (defun anc-of (node) (caddr node)) ;;; given a state and two jugs, what is the new state? (defun new-state ( s j1 j2) (let ((cont1 0) (cont2 0) (news nil)) ; remember contents of two jugs (setf cont1 (nth j1 s)) (setf cont2 (nth j2 s)) ; now lots of tests to "do the right thing" (cond ; don't fill self from self ( (= j1 j2) (setf news nil)) ; don't fill from empty jug ( (= cont1 0) (setf news nil)) ; don't fill full jug ( (= cont2 (nth j2 capacities)) (setf news nil)) ; fill j2 from reservoir ( (zerop j1) (setf news (copy-list s)) (setf (nth j2 news) (nth j2 capacities))) ; dump j1 into reservoir ( (zerop j2) (setf news (copy-list s)) (setf (nth j1 news) 0 )) ; finally the "general" case -- ; j1 is empty or has cont j1- (cap(j2)- contj2), whichever is > ; j2 is full or has conts j2 + j1, whichever is < (t (setf news (copy-list s)) (setf (nth j1 news) (max 0 (- cont1 (- (nth j2 capacities) cont2)))) (setf (nth j2 news) (min (nth j2 capacities) ( + cont1 cont2 ))))) ; return new state news ) ;end let ) ;end defun ;;; Generate all successors... examine every (j1, j2) ;;; pair to see which new states to add to sucessor list. ;;; new-state can return nil (ignore) or an already-visited ;;; state (ignore using hash table). (defun gen-succs (node) (let ((succs nil) (newnode nil) (jug1 0) (jug2 0)) (dotimes (jug1 n) (dotimes (jug2 n) ; generate a new state...it's either OK, nil (bad choice of j1,j1) ; or visited (setf newstate (new-state (state-of node) jug1 jug2)) (when (and newstate (not-visited newstate)) ; mark visited and create new node, stick on succ. list. (mark-visited newstate) (setf newnode (list newstate (list jug1 jug2) node )) (setf succs (cons newnode succs)) ))) ; return sucessors to the search routine succs ) ; end let ) ; end defun ;;; results ;(setf sux (gen-succs start-node )) ;(((1 0 5) (0 2) ((1 0 0) NIL NIL)) ((1 3 0) (0 1) ((1 0 0) NIL NIL))) ;(setf sux1 (gen-succs (car sux ))) ;(((1 3 2) (2 1) ((1 0 5) (0 2) ((1 0 0) NIL NIL))) ((1 3 5) (0 1) ((1 0 5) (0 2) ((1 0 0) NIL NIL)))) ;; OK, seems to make sense. Probably OK to start pushing and popping.... ;;;;;;;;;;;;;;;-----------klip here, below is not all lisp ------------ ;;;;;;;;;;;NOT SO FAST ????? ;;;;;;;;;;;;;;;;; CB: I got the following critique of the above code: S: is student's critique, CB: gives my thoughts: S: There are a couple tiny bugs in the provided code. CB has asked me to post my corrections. CB: thanks for writing them up! S: In new-state, the let statement is missing some parentheses. It should be: (defun new-state (s j1 j2) (let ((cont1 0) (cont2 0) (news nil)) ... CB: I don't think so. In my Lisp manuals, the syntax is something like (let (() () ) The entire rest of your subroutine ) So the code is evaluated in the scope of the let command. Let isn't strictly a function, it's an operator. In any event it actually COULD work either way, but my let was designed to keep variables local. S: new-state also has some logic errors. The ordering of the rules should be: (original order in parentheses) 1. don't fill self from self (1) 2. fill jug2 from reservoir (4) 3. don't fill from empty jug (2) 4. dump jug1 into reservoir (5) 5. don't fill full jug (3) 6. general case (6) The problem with the original logic is that the 0th jug is always empty (at least, in our implementation) so rule 3 was kicking in too early. There was another reason problem, though I don't fully remember it. I think we moved the "dump jug1 into reservoir" rule up since rule 5 was kicking in too early, but I could be wrong. CB: Aha, no, you can't have the 0th jug empty for just that reason. OR you could actually treat it totally differently. I found it easy to give it some amount (in my code above, 1 gallon). That way it does not show up as empty to that rule, but when you do pour from it of course you don't change its quantity: it's got to act ever-full and ever-empty and that's where the two special "reservoir" rules come from. As for other rule interactions and reordering... Always, always, the hope in writing search programs is that we should NOT need to think so deeply about the semantics of our rules or their interaction. As you see it's hard to remember how those things work. So let the computer do it! The program does brute search and then some necessary policing functions like don't allow repeated states, or don't allow ops that don't make forward progress, to keep really dumb stuff from happening. I am quite prepared to believe that there is an order that in general would allow more efficient discovery of helpful operations, but in general it sounds like a hard problem to guarantee that you'd never get in trouble, or that useful ops for one version of the problem would be the same for another version of the problem (more or fewer jugs in this case). So while this rule ordering may be an improvement (though I haven't checked), it may still not be enough to prevent problems like cycles, AND if you prevent cycles etc. maybe you don't need to worry about rule ordering....just let it bumble along until it finds the answer. S: The function gen-succs also has problems with parentheses in its let statement. It should read: (defun gen-succs (node) (let ((succs nil) (newnode nil)) ... (jug1 and jug2 will be defined by dotimes, so they don't need to be defined in the let) CB: See above.