1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
|
#lang scheme/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 (planet williams/inference/inference))
(define-ruleset towers-rules)
; If the target peg holds 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-rules)
(all (ring ? (on . right)))
==>
(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-2 towers-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-3 towers-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-4 towers-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-towers n)
(with-new-inference-environment
(activate towers-rules)
; (current-inference-trace #t)
; Create pegs.
(assert '(peg left))
(assert '(peg middle))
(assert '(peg right))
; Create rings.
(for ((i (in-range 1 n)))
(assert `(ring ,i (on . left))))
; Start inferencing.
(start-inference)))
; Test with 6 disks.
(solve-towers 6) |
Partager