Common lisp 河内塔与命名光盘

为了完成一项任务，我必须用通用LISP语言创建河内塔，并使用命名光盘。我需要得到如下输出：

[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 Medium Large)

[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

然而，当我运行我创建的程序时，我得到如下输出：

[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 Medium Large)

[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

这是我的密码：

(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*))

---

代码的问题显然是move disk函数，因为它只是在调用后丢弃结果。但我不确定如何准确地确定应该从哪些全局变量中推动和弹出。我曾经摆弄过使用一个大列表来表示塔，并将木桩作为其中的子列表，但我也有同样的问题，即确定要修改列表的哪一部分。任何帮助都将不胜感激。我觉得自己完全走到了死胡同。

这里的基本问题是，所有函数都在变量peg1、peg2和peg3的内容上运行，而不是在变量本身上运行。在peg name函数中，我们最初让peg2和peg3都是equals和eq，因为它们都是NIL，所以这种命名逻辑不起作用。类似地，push和pop正在移动磁盘中修改

从

和

到

变量，但对全局列表不做任何操作

您需要找到一种不同的方式来传递列表名称。基本上是某种实际的数组或键->值映射，而不是硬编码的变量，因此您可以传递键来修改正确的列表

您还可以考虑一个更纯粹的功能解决方案，它将PEG的名称与内容一起使用（使用CONS、CAR和CDR而不是推和POP）。这将完全避免造成所有麻烦的可变赋值运算符。

简单的解决方法是使用列表向量作为标记，然后传递正在操作的标记的索引

这将使您的移动磁盘功能类似于：

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

---

我认为，剩下的修改应该是非常直接的，以此为基础。

代码很容易修复。但是你的解决方案不是最好的，因为PEG是全局变量

代码中的主要混淆是列表和变量之间的混淆。宏（如PUSH和POP）在“位置”上工作，如符号值、变量或对象的插槽。直接使用列表无法按预期工作

(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)
  (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)))

传递符号，而不是列表。重置其他销钉也很有用

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

测试：

---

首先，如果我们只想生成运动序列，我们不需要保持任何内部状态；以下是无副作用的：

(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)))

第二，如果我们确实想跟踪状态变化，最好将状态保持在一个地方，而不是将其分散在许多全局变量上：

(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))))

---

push

和

pop

是通用Lisp中的标准宏。@EliasMårtenson:LOL我的Lisp太生疏了>_

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
  |
  |
  |█▄▂