@jkiiski 的基于列表的答案采用与 OP 相同的方法并对其进行了极大的优化。这里的目标不同:我尝试用另一种方式来表示问题(但仍然是蛮力),我们可以看到,使用向量和矩阵,我们可以更好、更快、更强地解决更难的问题1。
我还应用了与其他答案相同的启发式方法,这大大减少了寻找解决方案所需的工作量。
数据结构
(defpackage :knight (:use :cl))
(in-package :knight)
(declaim (optimize (speed 3) (debug 0) (safety 0)))
(deftype board () '(simple-array bit *))
(deftype delta () '(integer -2 2))
;; when we add -2, -1, 1 or 2 to a board index, we assume the
;; result can still fit into a fixnum, which is not always true in
;; general.
(deftype frontier () (list 'integer -2 most-positive-fixnum))
接下来,我们定义一个类来保存 Knight's Tour 问题的实例以及工作数据,即高度、宽度、代表棋盘的矩阵,包含 0(空)或 1(已访问),以及当前的游览,由大小为高 x 宽的向量表示,填充指针初始化为零。由于内部板已经存储了这些尺寸,因此该类中的尺寸并不是绝对必要的。
(defclass knights-tour ()
((visited-cells :accessor visited-cells)
(board :accessor board)
(height :accessor height :initarg :height :initform 8)
(width :accessor width :initarg :width :initform 8)))
(defmethod initialize-instance :after ((knight knights-tour)
&key &allow-other-keys)
(with-slots (height width board visited-cells) knight
(setf board (make-array (list height width)
:element-type 'bit
:initial-element 0)
visited-cells (make-array (* height width)
:element-type `(integer ,(* height width))
:fill-pointer 0))))
顺便说一句,我们还专注于print-object
:
(defmethod print-object ((knight knights-tour) stream)
(with-slots (width height visited-cells) knight
(format stream "#<knight's tour: ~dx~d, tour: ~d>" width height visited-cells)))
辅助功能
(declaim (inline visit unvisit))
访问位置x和y的单元意味着在板中的适当位置设置一个,并将当前单元的坐标推入访问单元向量。我存储行主要索引而不是几个坐标,因为它分配的内存更少(实际上差异并不重要)。
(defmethod visit ((knight knights-tour) x y)
(let ((board (board knight)))
(declare (board board))
(setf (aref board y x) 1)
(vector-push-extend (array-row-major-index board y x)
(visited-cells knight))))
不访问单元意味着在板上设置零并减少访问单元序列的填充指针。
(defun unvisit (knight x y)
(let ((board (board knight)))
(declare (board board))
(setf (aref board y x) 0)
(decf (fill-pointer (visited-cells knight)))))
详尽的搜索
递归访问函数如下。它首先访问当前单元,在每个空闲的有效邻居上递归调用自己,最后在退出之前取消访问。该函数接受一个回调函数,只要找到解决方案就调用(编辑:我不会重构,但我认为回调函数应该存储在knights-tour类的插槽中)。
(declaim (ftype
(function (knights-tour fixnum fixnum function)
(values &optional))
brute-visit))
(defun brute-visit (knight x y callback
&aux (board (board knight))
(cells (visited-cells knight)))
(declare (function callback)
(board board)
(type (vector * *) cells)
(fixnum x y))
(visit knight x y)
(if (= (fill-pointer cells) (array-total-size cells))
(funcall callback knight)
(loop for (i j) of-type delta
in '((-1 -2) (1 -2) (-2 -1) (2 -1)
(-2 1) (2 1) (-1 2) (1 2))
for xx = (the frontier (+ i x))
for yy = (the frontier (+ j y))
when (and (array-in-bounds-p board yy xx)
(zerop (aref board yy xx)))
do (brute-visit knight xx yy callback)))
(unvisit knight x y)
(values))
入口点
(defun knights-tour (x y callback &optional (h 8) (w 8))
(let ((board (make-instance 'knights-tour :height h :width w)))
(brute-visit board x y callback)))
测试 1
以下测试要求为 6x6 板找到解决方案:
(time (block nil
(knights-tour 0 0 (lambda (k) (return k)) 6 6)))
Evaluation took:
0.097 seconds of real time
0.096006 seconds of total run time (0.096006 user, 0.000000 system)
[ Run times consist of 0.008 seconds GC time, and 0.089 seconds non-GC time. ]
98.97% CPU
249,813,780 processor cycles
47,005,168 bytes consed
相比之下,其他版本的版本运行如下(原点相同,但我们索引单元格不同):
(time (knights-tour-brute 1 1 6 6))
Evaluation took:
0.269 seconds of real time
0.268017 seconds of total run time (0.268017 user, 0.000000 system)
99.63% CPU
697,461,700 processor cycles
17,072,128 bytes consed
测试 2
对于较大的电路板,差异更加明显。如果我们要求找到 8x8 板的解决方案,上述版本在我的机器上的作用如下:
> (time (block nil (knights-tour 0 0 (lambda (k) (return k)) 8 8)))
Evaluation took:
8.416 seconds of real time
8.412526 seconds of total run time (8.412526 user, 0.000000 system)
[ Run times consist of 0.524 seconds GC time, and 7.889 seconds non-GC time. ]
99.96% CPU
21,808,379,860 processor cycles
4,541,354,592 bytes consed
#<knight's tour: 8x8, tour: #(0 10 4 14 20 3 9 19 2 8 18 1 11 5 15 21 6 12 22 7
13 23 29 35 25 40 34 17 27 33 16 26 32 49 43 28
38 55 61 44 59 53 63 46 31 37 47 30 36 51 57 42
48 58 52 62 45 39 54 60 50 56 41 24)>
最初的基于列表的方法没有返回,十分钟后我杀死了工作线程。
启发式
仍有改进的空间(请参阅实际研究论文以获取更多信息),在这里我将像@jkiiski 的更新版本一样对邻居进行排序,看看会发生什么。以下只是对邻居进行抽象迭代的一种方式,因为我们将不止一次地使用它,而且不同:
(defmacro do-neighbourhood ((xx yy) (board x y) &body body)
(alexandria:with-unique-names (i j tx ty)
`(loop for (,i ,j) of-type delta
in '((-1 -2) (1 -2) (-2 -1) (2 -1)
(-2 1) (2 1) (-1 2) (1 2))
for ,tx = (the frontier (+ ,i ,x))
for ,ty = (the frontier (+ ,j ,y))
when (and (array-in-bounds-p ,board ,ty ,tx)
(zerop (aref ,board ,ty ,tx)))
do (let ((,xx ,tx)
(,yy ,ty))
,@body))))
我们需要一种方法来计算可能的邻居数量:
(declaim (inline count-neighbours)
(ftype (function (board fixnum fixnum ) fixnum)
count-neighbours))
(defun count-neighbours (board x y &aux (count 0))
(declare (fixnum count x y)
(board board))
(do-neighbourhood (xx yy) (board x y)
(declare (ignore xx yy))
(incf count))
count)
这是替代搜索实现:
(defstruct next
(count 0 :type fixnum)
(x 0 :type fixnum)
(y 0 :type fixnum))
(defun brute-visit (knight x y callback
&aux (board (board knight))
(cells (visited-cells knight)))
(declare (function callback)
(board board)
(type (vector * *) cells)
(fixnum x y))
(visit knight x y)
(if (= (fill-pointer cells) (array-total-size cells))
(funcall callback knight)
(let ((moves (make-array 8 :element-type 'next
:fill-pointer 0)))
(do-neighbourhood (xx yy) (board x y)
(vector-push-extend (make-next :count (count-neighbours board xx yy)
:x xx
:y yy)
moves))
(map nil
(lambda (next)
(brute-visit knight
(next-x next)
(next-y next)
callback)
(cerror "CONTINUE" "Backtrack detected"))
(sort moves
(lambda (u v)
(declare (fixnum u v))
(<= u v))
:key #'next-count)
)))
(unvisit knight x y)
(values))
尝试以前的测试时,结果是立竿见影的。例如,对于64x64板:
knight> (time
(block nil
(knights-tour
0 0
(lambda (k) (return))
64 64)))
Evaluation took:
0.012 seconds of real time
0.012001 seconds of total run time (0.012001 user, 0.000000 system)
100.00% CPU
29,990,030 processor cycles
6,636,048 bytes consed
为 5x5 板找到 1728 个解决方案需要 42 秒。
这里我保留了回溯机制,为了看看我们是否需要它,我在搜索中添加了一个cerror
表达式,以便在搜索尝试另一条路径时立即通知我们。以下测试触发错误:
(time
(dotimes (x 8)
(dotimes (y 8)
(block nil
(knights-tour
x y
(lambda (k) (return))
8 8)))))
报告错误的x和y值分别为2和1。
1作为参考,请参阅Daft Punk。