(module towers-vector mzscheme ;(require (planet "inference.ss" ("williams" "inference.plt"))) (require "../inference.ss") ;; Example Inference Model ;; Towers of Hanoi from Artificial Intelligence: Tools, Techniques, ;; and Applications, Tim O'Shea and Marc Eisenstadt, Harper & Rowe, ;; 1984, pp.45 ;; ;; The rules of the game are: (1) move one ring at a time and (2) ;; never place a larger ring on top of a smaller ring. The object ;; ive isto transfer the entire pile of rings from its starting ;; peg to either of the other pegs - the target peg. (define-ruleset towers-vector-rules) ;; If the target peg hld all the rings 1 to n, stop because according ;; to game rule (2) they must be in their original order and so the ;; problem is solved. (define-rule (rule-1 towers-vector-rules) (all #(ring ? on right)) ==> (printf "Problem solved!~n")) ;; If there is no current goal - that is, if a ring has just been ;; successfully moved, or if no rings have yet to be moved - generate ;; a goal. In this case the goal is to be that of moving to the ;; target peg the largest ring that is not yet on the target peg. (define-rule (rule-2 towers-vector-rules) (no (move . ?)) #(ring ?size on (?peg (not (eq? ?peg 'right)))) (no #(ring (?size-1 (> ?size-1 ?size)) on (?peg-1 (not (eq? ?peg-1 'right))))) ==> (assert `(move ,?size from ,?peg to right))) ;; If there is a current goal, it can be achieved at once of there is ;; no small rings on top of the ring to be moved (i.e. if the latter ;; is at the top of its pile), and there are no small rings on the ;; peg to which it is to be moved (i.e. the ring to be moved is ;; smaller that the top ring on the peg we intend to move it to). If ;; this is the case, carry out the move and then delete the current ;; goal so that rule 2 will apply next time. (define-rule (rule-3 towers-vector-rules) (?move <- (move ?size from ?from to ?to)) (?ring <- #(ring ?size on ?from)) (no #(ring (?size-1 (< ?size-1 ?size)) on ?from)) (no #(ring (?size-2 (< ?size-2 ?size)) on ?to)) ==> (printf "Move ring ~a from ~a to ~a.~n" ?size ?from ?to) (modify ?ring `#(ring ,?size on ,?to)) (retract ?move)) ;; If there is a current goal but its disc cannot be moved as in rule ;; 3, set up a new goal: that of moving the largest of the obstructing ;; rings to the peg that is neither of those specified in the current ;; goal (i.e. well out of the way of the current goal). Delete the ;; current goal, so that rule 2 will apply to the new goal next time. (define-rule (rule-4 towers-vector-rules) (?move <- (move ?size from ?from to ?to)) (peg (?other (not (memq ?other (list ?from ?to))))) #(ring (?size-1 (< ?size-1 ?size)) on (?peg-1 (not (eq? ?peg-1 ?other)))) (no #(ring (?size-2 (< ?size-1 ?size-2 ?size)) on (?peg-2 (not (eq? ?peg-2 ?other))))) ==> (modify ?move `(move ,?size-1 from ,?peg-1 to ,?other))) (define (solve-towers n) (with-new-inference-environment (activate towers-vector-rules) ;(current-inference-trace #t) ;; Create pegs. (assert '(peg left)) (assert '(peg middle)) (assert '(peg right)) ;; Create rings. (do ((i 1 (+ i 1))) ((> i n) (void)) (assert `#(ring ,i on left))) ;; Start inferencing. (start-inference))) (solve-towers 6) )