Towers of Hanoi with Named Discs

For an assignment I have to create Towers of Hanoi in Common LISP with named discs. I need to get output that looks something like this:

[1]> (hanoi '(Small Medium Large))
Moved SMALL from Peg 1 to Peg 3
Moved MEDIUM from Peg 1 to Peg 2
Moved SMALL from Peg 3 to Peg 2
Moved LARGE from Peg 1 to Peg 3
Moved SMALL from Peg 2 to Peg 1
Moved MEDIUM from Peg 2 to Peg 3
Moved SMALL from Peg 1 to Peg 3
NIL
[2]> peg1
NIL
[3]> peg2
NIL
[4]> peg3
(Small Mediu开发者_如何学JAVAm Large)

Yet when I run the program I have created I get output like this:

[1]> (hanoi '(Small Medium Large))
Move SMALL from Peg 1 to Peg 2
Move SMALL from Peg 1 to Peg 2
Move NIL from Peg 2 to Peg 2
Move SMALL from Peg 1 to Peg 2
Move NIL from Peg 2 to Peg 1
Move NIL from Peg 2 to Peg 2
Move SMALL from Peg 1 to Peg 2
NIL
[2]> peg1
(Small Medium Large)
[3]> peg2
NIL
[4]> peg3
NIL

Here is my code:

(defvar *peg1* '())
(defvar *peg2* '())
(defvar *peg3* '())

(defun peg-name (peg)
     (cond ((equal peg *peg1*) "Peg 1")
     ((equal peg *peg2*) "Peg 2")
     ((equal peg *peg3*) "Peg 3")))

(defun move-disk (from to)
     (format t "Move ~a from ~a to ~a~%" (first from) (peg-name from) (peg-name to))
     (push (pop from) to))

(defun transfer (n source aux dest)
     (if (> n 0)
          (progn
          (transfer (1- n) source dest aux)
          (move-disk source dest)
          (transfer (1- n) aux source dest))))

(defun hanoi (disk-list)
     (setq *peg1* disk-list)
     (transfer (length disk-list) *peg1* *peg2* *peg3*))

The problem with the code is obviously the move-disk function, since it is just throwing away the result after it is called. But I am not sure how exactly I can determine which of the global variables I should be pushing and popping from. I've fiddled with using a large list to represent the tower and having the pegs be sublists in it, but I have the same problem of determining what part of the list to modify. Any help would be appreciated. I feel like I am at a complete dead end.

The code is easy to repair. But your solution is not the best style, since the pegs are global variables.

The main confusion in your code is between lists and variables. Macros like PUSH and POP are working over 'places', like symbol values, variables or object's slots. Using a list directly does not work as expected.

(defvar *peg1* '())
(defvar *peg2* '())
(defvar *peg3* '())

Make sure to compare the symbols, not the values.

(defun peg-name (peg)
  (cond ((equal peg '*peg1*) "Peg 1")
        ((equal peg '*peg2*) "Peg 2")
        ((equal peg '*peg3*) "Peg 3")))

Since we pass symbols, we need to pop from and push to the symbol's values.

(defun move-disk (from to)
  (let ((disc (pop (symbol-value from))))
    (format t "Move ~a from ~a to ~a~%" disc (peg-name from) (peg-name to))
    (push disc (symbol-value to))))

(defun transfer (n source aux dest)
  (when (> n 0)
    (transfer (1- n) source dest aux)
    (move-disk source dest)
    (transfer (1- n) aux source dest)))

Pass the symbols, not the lists. It is also useful to reset the other pegs.

(defun hanoi (disk-list)
  (setq *peg1* disk-list)
  (setq *peg2* '())
  (setq *peg3* '())
  (transfer (length disk-list) '*peg1* '*peg2* '*peg3*))

Test:

CL-USER 15 > (hanoi '(Small Medium Large))
Move SMALL from Peg 1 to Peg 3
Move MEDIUM from Peg 1 to Peg 2
Move SMALL from Peg 3 to Peg 2
Move LARGE from Peg 1 to Peg 3
Move SMALL from Peg 2 to Peg 1
Move MEDIUM from Peg 2 to Peg 3
Move SMALL from Peg 1 to Peg 3
NIL

CL-USER 16 > *peg3*
(SMALL MEDIUM LARGE)

CL-USER 17 > *peg1*
NIL

The "easy" fix is to use a vector of lists as your pegs, then pass the index of the peg you're manipulating.

That'd make your MOVE-DISK function something like:

(defun move-to (from to)
   (push (pop (aref *pegs* from)) (aref *pegs* to))

The rest of the modifications should be pretty straight-forward with that as a base, I think.

The basic problem here is that all the functions are operating over the contents of the variables peg1 peg2 and peg3 instead of over the variables themselves. In the peg-name function we initially have peg2 and peg3 being both equals and eq since both are NIL so this kind of logic to give names doesn't work. Similarly, the push and pops are modifying the from and to variables inside move-disk but doing nothing to the global lists.

You need to find a different way to pass the list names around. Basically some sort of actual array or key->value map instead of the hardcoded variables so you can pass the keys around to modify the correct lists.

You could also consider a more purely functional solution that passes the name of the peg together with its contents (and using cons, car and cdr instead of push and pop). This would completely avoid the mutable assignment operators that are causing all the trouble.

First, if we just want to generate the movement sequence, we don't need to keep any internal state; the following is side-effect free:

(defun hanoi (disk-list)
  (labels ((transfer (i source aux dest)
             (when (< 0 i)
               (transfer (1- i) source dest aux)
               (move (1- i) source dest)
               (transfer (1- i) aux source dest)))
           (move (disk source dest)
             (format t "Move ~A from Peg ~A to Peg ~A~%"
                     (elt disk-list disk) source dest)))
    (transfer (length disk-list) 1 2 3)))

Example:

CL-USER> (hanoi '(small medium large))
Move SMALL from Peg 1 to Peg 3
Move MEDIUM from Peg 1 to Peg 2
Move SMALL from Peg 3 to Peg 2
Move LARGE from Peg 1 to Peg 3
Move SMALL from Peg 2 to Peg 1
Move MEDIUM from Peg 2 to Peg 3
Move SMALL from Peg 1 to Peg 3

Second, if we do want to keep track of the state changes, it's much preferable to keep the state in a single place instead of spreading it over many global variables:

(defun hanoi* (disk-list)
  (let ((state (list disk-list nil nil)))
    (labels ((transfer (i source aux dest)
               (when (< 0 i)
                 (transfer (1- i) source dest aux)
                 (move (1- i) source dest)
                 (transfer (1- i) aux source dest)))
             (move (disk source dest)
               (format t "Move ~A from Peg ~A to Peg ~A~%"
                       (elt disk-list disk) (1+ source) (1+ dest))
               (push (pop (elt state source)) (elt state dest))
               (show state))
             (show (state)
               (format t "~{  |~{~A~}~%~}" (mapcar #'reverse state))))
      (show state)
      (transfer (length disk-list) 0 1 2))))

Example:

CL-USER> (hanoi* '(#\▂ #\▄ #\█))
  |█▄▂
  |
  |
Move ▂ from Peg 1 to Peg 3
  |█▄
  |
  |▂
Move ▄ from Peg 1 to Peg 2
  |█
  |▄
  |▂
Move ▂ from Peg 3 to Peg 2
  |█
  |▄▂
  |
Move █ from Peg 1 to Peg 3
  |
  |▄▂
  |█
Move ▂ from Peg 2 to Peg 1
  |▂
  |▄
  |█
Move ▄ from Peg 2 to Peg 3
  |▂
  |
  |█▄
Move ▂ from Peg 1 to Peg 3
  |
  |
  |█▄▂