recursion - 优化骑士之旅 LISP

Question

我是 LISP 的新手，我在使用以下代码时遇到了这个问题。

(defun knights-tour-brute (x y m n) 
  (setq height m)     
  (setq width n)      
  (setq totalmoves (* height width))  
  (setq steps 1)      
  (setq visited-list (list (list x y))) 
  (tour-brute (list (list x y))))
(defun tour-brute (L)
  (cond
   ((null L) NIL)   
   ((= steps totalmoves) L)   
   (t
    (let ((nextmove (generate L)))
      (cond ((null nextmove) (backtrack (car (last L)))
                             (tour-brute (reverse (cdr (reverse L)))))
            (t (setq visited-list (append visited-list (list nextmove)))
               (tour-brute (append L (list nextmove))))))))) 

(defun generate (L)
  (let ((x (caar (last L))) 
        (y (cadar (last L)))) 
    (setq steps (+ 1 steps))  
    (cond
     ((correct-state(+ x 2) (+ y 1) L) (list (+ x 2) (+ y 1)))
     ((correct-state (+ x 2) (- y 1) L) (list (+ x 2) (- y 1)))
     ((correct-state (- x 1) (+ y 2) L) (list (- x 1) (+ y 2)))
     ((correct-state (+ x 1) (+ y 2) L) (list (+ x 1) (+ y 2)))
     ((correct-state (+ x 1) (- y 2) L) (list (+ x 1) (- y 2)))
     ((correct-state (- x 1) (- y 2) L) (list (- x 1) (- y 2)))
     ((correct-state (- x 2) (+ y 1) L) (list (- x 2) (+ y 1)))
     ((correct-state (- x 2) (- y 1) L) (list (- x 2) (- y 1)))
     (t (setq steps (- steps 2)) NIL))))

(defun correct-state (x y L)
  (if (and (<= 1 x)
           (<= x height)
           (<= 1 y)
           (<= y width)
           (not (visited (list x y) L))
           (not (visited (list x y) 
                (tail (car (last L)) visited-list)))) (list (list x y)) NIL))

(defun tail (L stateslist)
  (cond
   ((equal L (car stateslist)) (cdr stateslist))
   (t (tail L (cdr stateslist)))))

(defun visited (L stateslist)
  (cond
   ((null stateslist) NIL)   
   ((equal L (car stateslist)) t) 
   (t (visited L (cdr stateslist)))))

(defun backtrack (sublist)
  (cond
   ((null visited-list) t)
   ((equal sublist (car (last visited-list))) t)
   (t (setq visited-list (reverse (cdr (reverse visited-list)))) 
      (backtrack sublist))))

它返回一个错误 *** - 程序堆栈溢出。重置。当我四处搜索时，我意识到这是递归的结果。但是我不确定我应该如何优化这段代码来解决这个问题。非常感谢任何帮助。

您好，上面是更新后的代码。这是测试代码。(骑士巡回赛 5 5 1 1)

Answer 1

正如我在评论中提到的，问题是缺少Tail Call Optimisation (TCO) .您可以使用

启用它

(declaim (optimize (speed 3)))

但这取决于您的实现。我不确定 CLISP。

编辑:其他答案有更有效的方法来解决问题，但仍然值得阅读此答案以更好地编写原始解决方案

无论如何，我对代码进行了一些优化。您仍然需要拥有 TCO 才能运行它。这是像这样使用递归的固有问题。它应该在 SBCL 下运行良好至少。只需将其保存到文件中，然后执行

(load (compile-file "file.lisp"))

它应该比您的原始代码运行得更快，并且分配的内存更少。 (time (knights-tour-brute 1 1 6 6)) 的相关数字与您的代码:

4,848,466,907 processor cycles
572,170,672 bytes consed

还有我的代码:

1,155,406,109 processor cycles
17,137,776 bytes consed

在大多数情况下，我保留了您的代码。我所做的更改主要是:

1. 我实际上声明了全局变量并清理了一些代码。
2. 在您的版本中，您按顺序构建visited-list。当您不了解 Lisp 中的单向链表如何工作时，这可能看起来很直观，但它非常低效(那些 (reverse (cdr (reverse list))) 真的很吃性能)。您应该阅读一些有关列表的 Lisp 书籍。我保持它的倒序，然后最后用 nreverse 反转它。
3. 您使用列表作为坐标。我改用结构。性能大大提高。
4. 我为所有内容添加了类型声明。它稍微提高了性能。

不过还是一样的蛮力算法，所以对于更大的板子会很慢。您应该为这些研究更智能的算法。

(declaim (optimize (speed 3) (space 0) (safety 0) (debug 0)))

(declaim (type fixnum *height* *width* *total-moves* *steps*))
(declaim (type list *visited-list*))

(declaim (ftype (function (fixnum fixnum fixnum fixnum) list)
                knights-tour-brute))
(declaim (ftype (function (list) list)
                tour-brute))
(declaim (ftype (function (list) (or pos null))
                generate))
(declaim (ftype (function (fixnum fixnum list) (or t null))
                correct-state))
(declaim (ftype (function (fixnum fixnum list) (or t null))
                visited))
(declaim (ftype (function (pos) t)
                backtrack))
(declaim (ftype (function (fixnum fixnum pos) (or t null))
                vis-2))
(declaim (ftype (function (pos pos) (or t null))
                pos=))
(declaim (ftype (function (pos fixnum fixnum) (or t null))
                pos=*))

(defstruct pos
  (x 0 :type fixnum)
  (y 0 :type fixnum))

(defmethod print-object ((pos pos) stream)
  (format stream "(~d ~d)" (pos-x pos) (pos-y pos)))

(defparameter *height* 0)
(defparameter *width* 0)
(defparameter *total-moves* 0)
(defparameter *steps* 0)
(defparameter *visited-list* '())

(defun knights-tour-brute (x y m n)
  (let ((*height* m)
        (*width* n)
        (*total-moves* (* m n))
        (*steps* 1) 
        (*visited-list* (list (make-pos :x x :y y))))
    (nreverse (tour-brute (list (make-pos :x x :y y))))))

(defun tour-brute (l)
  (cond
    ((null l) nil)
    ((= *steps* *total-moves*) l)   
    (t (let ((nextmove (generate l)))
         (cond
           ((null nextmove)
            (backtrack (first l))
            (tour-brute (rest l)))
           (t (push nextmove *visited-list*)
              (tour-brute (cons nextmove l)))))))) 

(defun generate (l)
  (let ((x (pos-x (first l)))
        (y (pos-y (first l))))
    (declare (type fixnum x y))
    (incf *steps*)
    (cond
      ((correct-state (+ x 2) (+ y 1) l) (make-pos :x (+ x 2) :y (+ y 1)))
      ((correct-state (+ x 2) (- y 1) l) (make-pos :x (+ x 2) :y (- y 1)))
      ((correct-state (- x 1) (+ y 2) l) (make-pos :x (- x 1) :y (+ y 2)))
      ((correct-state (+ x 1) (+ y 2) l) (make-pos :x (+ x 1) :y (+ y 2)))
      ((correct-state (+ x 1) (- y 2) l) (make-pos :x (+ x 1) :y (- y 2)))
      ((correct-state (- x 1) (- y 2) l) (make-pos :x (- x 1) :y (- y 2)))
      ((correct-state (- x 2) (+ y 1) l) (make-pos :x (- x 2) :y (+ y 1)))
      ((correct-state (- x 2) (- y 1) l) (make-pos :x (- x 2) :y (- y 1)))
      (t (decf *steps* 2)
         nil))))

(defun correct-state (x y l)
  (and (<= 1 x *height*)
       (<= 1 y *width*)
       (not (visited x y l))
       (vis-2 x y (first l))))

(defun visited (x y stateslist)
  (loop
     for state in stateslist
     when (pos=* state x y) do (return t)))

;;---TODO: rename this
(defun vis-2 (x y l-first)
  (loop
     for state in *visited-list*
     when (pos= l-first state) do (return t)
     when (pos=* state x y) do (return nil)))

(defun backtrack (sublist)
  (loop
     for state in *visited-list*
     while (not (pos= sublist state))
     do (pop *visited-list*)))

(defun pos= (pos1 pos2)
  (and (= (pos-x pos1)
          (pos-x pos2))
       (= (pos-y pos1)
          (pos-y pos2))))
(defun pos=* (pos1 x y)
  (and (= (pos-x pos1) x)
       (= (pos-y pos1) y)))

编辑:我改进了 correct-state 以便不会两次查看同一个列表。显着减少成本。

Edit2:我改用位置结构而不是使用 cons-cells。这会显着提高性能。

它可能可以进一步优化，但对于 6x6 的板来说应该足够快了。如果您需要更好的性能，我认为切换到不同的算法会比尝试优化蛮力解决方案更有效率。如果有人确实想要对此进行优化，这里有一些分析结果。

sb-sprof 的结果表明，大部分时间花在检查相等性上。我认为对此没有什么可做的。 visited 也需要相当多的时间。也许将访问过的位置存储在一个数组中会加快速度，但我还没有尝试过。

           Self        Total        Cumul
  Nr  Count     %  Count     %  Count     %    Calls  Function
------------------------------------------------------------------------
   1   1631  40.8   3021  75.5   1631  40.8        -  VISITED
   2   1453  36.3   1453  36.3   3084  77.1        -  POS=*
   3    337   8.4   3370  84.3   3421  85.5        -  CORRECT-STATE
   4    203   5.1   3778  94.5   3624  90.6        -  GENERATE
   5    101   2.5    191   4.8   3725  93.1        -  VIS-2
   6     95   2.4     95   2.4   3820  95.5        -  POS=
   7     88   2.2   3990  99.8   3908  97.7        -  TOUR-BRUTE
   8     44   1.1     74   1.9   3952  98.8        -  BACKTRACK
   9     41   1.0     41   1.0   3993  99.8        -  MAKE-POS

:ALLOC 模式没有提供太多有用的信息:

           Self        Total        Cumul
  Nr  Count     %  Count     %  Count     %    Calls  Function
------------------------------------------------------------------------
   1   1998  50.0   3998  99.9   1998  50.0        -  TOUR-BRUTE
   2   1996  49.9   1996  49.9   3994  99.9        -  MAKE-POS

sb-profile 显示 generate 完成了大部分时间，而 visited 花费了大部分时间(注意当然是秒由于仪表化而偏离了):

  seconds  |     gc     |   consed   |    calls   |  sec/call  |  name  
-------------------------------------------------------------
     8.219 |      0.000 |    524,048 |  1,914,861 |   0.000004 | VISITED
     0.414 |      0.000 |     32,752 |    663,273 |   0.000001 | VIS-2
     0.213 |      0.000 |     32,768 |    266,832 |   0.000001 | BACKTRACK
     0.072 |      0.000 |          0 |  1,505,532 |   0.000000 | POS=
     0.000 |      0.000 |          0 |          1 |   0.000000 | TOUR-BRUTE
     0.000 |      0.024 | 17,134,048 |    533,699 |   0.000000 | GENERATE
     0.000 |      0.000 |     32,768 |  3,241,569 |   0.000000 | CORRECT-STATE
     0.000 |      0.000 |     32,752 | 30,952,107 |   0.000000 | POS=*
     0.000 |      0.000 |          0 |          1 |   0.000000 | KNIGHTS-TOUR-BRUTE
-------------------------------------------------------------
     8.918 |      0.024 | 17,789,136 | 39,077,875 |            | Total