;;; hanoi.scm
;;;
;;; The function hanoi simulates solutions to Lucas's Tower of Hanoi puzzle.
;;;
;;; Written for CS 32, Fall 2005
;;; Copyright 2003, 2004, 2005 Robert R. Snapp

;; Concise representation: The state of the Tower of Hanoi puzzle is
;; represented by a single list of integers.  The first integer represents
;; the peg (1, 2,  or 3) on which the smallest disk rests, the second
;; integer, the peg on which the second smallest disk rests, and so, on.
;;
;; Thus, the initial state is (1 1 ... 1), and the goal state is (3 3 ... 3).
;;
(define make-list
  (lambda (n value)
    (cond ((= n 0) '())
          (else (cons value (make-list (- n 1) value))))))

;; remove-all : symbol -> list
;; removes every occurence of symbol s from the list lst.
;; (This function is like anteater.)
;;
;; Examples: (remove-all 'a '(b a c a b)) -> (b c b), and
;; (remove-all 'z '(b a c a b)) -> (b a c a b).
(define remove-all
  (lambda (s lst)
    (cond ((null? lst) '()); an empty list
          ((eq? s (car lst)) (remove-all s (cdr lst)))
          (else (cons (car lst) (remove-all s (cdr lst)))))))

;; Creates an instance of the tower of Hanoi puzzle with n disks on one
;; tower, and no disks on the remaining two towers.
(define initial-state
  (lambda (n)
    (make-list n 1)))

;; (move-check? src-peg dst-peg state), where src-peg and dst-peg are
;; integers, and state is a list of integers, rturns true if the
;; smallest disk on peg src-peg can be moved to peg dst-peg, i.e., if
;; the first occurance of src-peg appears in the state list before
;; the first occurance of dst-peg. Thus
;;      (move-check? 2 1 '(2 1 3 1 1 2 3)) => #t
;; as the smallest disk on peg 2 can be placed on the smallest disk
;; currently on peg 1; but,
;;      (move-check? 1 2 '(2 1 3 1 1 2 3)) => #f.
;; Likewise,
;;      (move-check? 1 2 '(3 3 3 3 3 3)) => #f,
;; as there aren't any disks on peg 1.
(define move-check?
  (lambda (src-peg dst-peg state)
    (cond ((null? state) #f) ; There is no disk on src-peg!
          ((eq? (car state) src-peg) #t)
          ((eq? (car state) dst-peg) #f)
          (else (move-check? src-peg dst-peg (cdr state))))))

;; Attempt to move the disk that is at the top of peg src-peg into the
;; top position of peg dst-peg. If the move is legal, then the new state
;; is returned. Otherwise, #f is returned.
(define move-disk
  (lambda (src-peg dst-peg state)
    (cond ((null? state) #f) ; illegal move: src-peg is empty
          ((eq? (car state) dst-peg) #f) ; illegal-move: dst-peg contains a smaller disc.
          ((eq? (car state) src-peg) (cons dst-peg (cdr state))) ; perform the move and return.
          (else (cons (car state) (move-disk src-peg dst-peg (cdr state)))))))

;; Applies a sequence of moves to the indicated state.
(define sequential-move
  (lambda (move-list state)
    (if (null? move-list) ; Is the move-list empty?
        state
        (let* ((next-move (car move-list))
               (src-peg (car next-move))
               (dst-peg (cadr next-move))
               (next-state (move-disk src-peg dst-peg state)))
          (if next-state
              (begin
                (printf "Moving disk on peg ~a to peg ~a yields state ~a.\n"
                        src-peg dst-peg next-state)
                (sequential-move (cdr move-list) next-state))
              (error 'sequential-move "Illegal move."))))))

;; agent: integer integer n -> list
;; agent generates a list of legal moves in the form:
;;
;; ((src-peg1 dst-peg1) ... (src-pegn dst-pegn))
;;
;; that moves a stack of k disks from the home-peg to the target-peg.
;;
;; Example:
;;  (agent 1 3 3) => ((1 3) (1 2) (3 2) (1 3) (2 1) (2 3) (1 3))
;;
(define (agent home-peg target-peg n)
  (let ((spare-peg (car (remove-all home-peg (remove-all target-peg '(1 2 3))))))
    (if (<= n 0)
        '() ; an empyt list
        (append (agent home-peg spare-peg (- n 1))
                (list (list home-peg target-peg))
                (agent spare-peg target-peg (- n 1))))))


;; hanoi: integer -> list
;; solves and simulates the shortest solution to the tower of hanoi puzzle with n disks.
;; Since the function sequential-move is invoked, each intermediate state is displayed.
;; The final state, a list of n threes, is returned.
;;
;; Example (hanoi 3) => (3 3 3), and displays:
;;
;;   Initial state = (1 1 1)
;;   Moving disk on peg 1 to peg 3 yields state (3 1 1).
;;   Moving disk on peg 1 to peg 2 yields state (3 2 1).
;;   Moving disk on peg 3 to peg 2 yields state (2 2 1).
;;   Moving disk on peg 1 to peg 3 yields state (2 2 3).
;;   Moving disk on peg 2 to peg 1 yields state (1 2 3).
;;   Moving disk on peg 2 to peg 3 yields state (1 3 3).
;;   Moving disk on peg 1 to peg 3 yields state (3 3 3).
;;

(define (hanoi n)
  (let ((state (initial-state n)))
    (printf "Initial state = ~a\n" state)
    (sequential-move (agent 1 3 n) state)))