#langscheme/base;;; PLT Scheme Inference Collection
;;; towers-alist.ss
;;;
;;; 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
;;; is to transfer the entire pile of rings from its starting
;;; peg to either of the other pegs - the target peg.
(require (planetwilliams/inference/inference))
(define-rulesettowers-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-1towers-rules)
(all (ring? (on . right)))
==>
(printf"Problem solved!~n")
(succeed))
;;; 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-2towers-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 . ,?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-3towers-rules)
(?move<- (move (size . ?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)
(replace?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-4towers-rules)
(?move<- (move (size . ?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)))))
==>
(replace?move`(move (size . ,?size-1) (from . ,?peg-1) (to . ,?other))))
;;; The main routine:
;;; In a new inference environment:
;;; Activate the towers rule set.
;;; Optionally, turn on tracing.
;;; Create the three pegs - left, middle, and right.
;;; Create the n rings.
;;; Start the inference.
;;; The rules will print the solution to the problem.
(define (solve-towersn)
(with-new-inference-environment
(activatetowers-rules)
;(current-inference-trace #t)
;; Create pegs.
(assert'(pegleft))
(assert'(pegmiddle))
(assert'(pegright))
;; Create rings.
(for ((i (in-range1n)))
(assert`(ring,i (on . left))))
;; Start inferencing.
(start-inference)))
;;; Test with 6 disks.
(solve-towers6)