Dancing Links
Algorithm X と Dancing Links は、クヌース先生が開発した Exact Cover Problem という問題を解くためのアルゴリズムとデータ構造です。前回に引き続き簡単な「敷き詰め問題」を例題にして、今回は Dancing Links について説明します。
●Dancing Links とは？
クヌース先生の Dancing Links は、行列の 1 の要素を縦方向と横方向の双方向リストでつないだデータ構造です。Dancing Links の図を再掲します。
H は行列全体のヘッダーで、1, 2, 3, 4, 5 が列を表すヘッダーです。列のヘッダーから縦のリンクをたどれば、要素を含む部分集合を簡単に求めることができます。また、横のリンクをたどれば、その部分集合の要素も簡単に求めることができます。
双方向リストの場合、リンクから節 (node) を削除したり、それを元に戻すことは節のデータを書き換えることで簡単にできます。列を取り除く場合、列ヘッダーをつないでいる横のリンクから、該当する列のヘッダーを削除すればいいわけです。部分集合を削除する場合は、節の横のリンクをたどり、縦のリンクから節を削除することで実現できます。
節 (node) の構造を図に示すと次のようになります。
prev と next で横方向の節を連結し、up と down で縦の節を連結します。節の基本的な操作は双方向リストと同じです。双方向リストの説明は、拙作のページ CLOS 入門 双方向リスト や Algorithms with Python 連結リストとキュー をお読みください。
●Dancing Links の操作方法
Dancing Links から列と行を取り除く操作は簡単です。選択した部分集合の節を node としましょう。node の横のリンクをたどると、削除する列を求めることができます。node の縦のリンクをたどると、削除する部分集合を求めることができます。
Dancing Links の場合、列をひとつ削除したら、その列に属する部分集合を削除します。このとき、node につながっている縦のリンクは残しておいて、それ以外の節を縦のリンクから外すところがポイントです。列に属する部分集合を削除したあと、node の横のリンクをたどり、次の列を削除します。
簡単な例を示しましょう。次の図を見てください。
最初に、列 4 にある節 C4 を選択します。次に、列ヘッダー 4 をヘッダーのリンクから外します。このとき、節 C4 は縦のリンクから削除しません。その次に、C4 の縦のリンクをたどりますが、ヘッダー以外の節はないので、C4 の横のリンクをたどります。
次に、節 C3 の列を削除します。列ヘッダー 3 を削除し、C3 の縦のリンクをたどります。すると、節 B3 が見つかるので、B3 の横のリンクをたどって、節を縦のリンクから外します。このとき、B3 は縦のリンクから削除しません。B3 の横のリンクをたどると、節 B2 が見つかります。B2 を列 2 から削除します。
横のリンクから外した節を赤色で、縦のリンクから外した節を黄色で示すと、次のようになります。
次は列 1 の節 A1 を選びます。最初に、列ヘッダー 1 を削除して、A1 の縦のリンクをたどります。すると、節 D1 が見つかるので、D1 の横のリンクをたどって、節 D5 を縦のリンクから外します。列 1 にリンクされている節はこれだけです。
次に、A1 の横のリンクをたどると、節 A2 が見つかります。列ヘッダー 2 を削除して、A2 の縦のリンクをたどります。B2 は削除されているので、節 F2 が見つかります。F2 の横にリンクされている節はないので、節の削除は行いません。
あとは、同様に列 5 の節 E5 を選ぶと行列は空になります。ここで、解をひとつ見つけることができました。
Dancing Links を復元する場合も同様の操作で行うことができます。ただし、節をリンクから外したときと逆の順番で節をリンクに戻すことに注意してください。節を横のリンクから外すとき、next の方向へ節をたどったならば、復元するときは prev の方向へたどります。縦のリンクから外すとき、down の方向へたどったならば、復元するときは up の方向へたどります。たとえば、列ヘッダー 3, 4 を削除したとき、4, 3 の順番で削除したので、戻すときは 3, 4 の順番で行います。
文章で説明すると複雑な処理のように思えますが、実際にプログラムを作ってみると簡単なので心配しないでください。
●データ構造の定義
それではプログラムを作りましょう。最初にデータ構造を定義します。
リスト : データ構造の定義
;;; 節
(defstruct dnode
up down prev next num header (len 0))
;;; 節の生成
(defun make-new-dnode (n)
(let ((node (make-dnode :num n)))
(setf (dnode-up node) node)
(setf (dnode-down node) node)
(setf (dnode-prev node) node)
(setf (dnode-next node) node)
(setf (dnode-header node) node)
node))
節は構造体で定義します。名前は dnode としました。up, down, prev, next は縦と横のリンクを表します。num は列または行の番号を格納し、header は列ヘッダーを格納します。節が列ヘッダーの場合は自分自身を格納します。len は列の長さを表します。列ヘッダー以外の節は 0 にセットします。
関数 make-new-node は新しい節を生成して返します。引数 n は列または行の番号です。関数 make-dnode で節 node を生成して、up, down, prev, next, header を自分自身の値で初期化します。構造体の使い方は拙作のページ Common Lisp 入門: 構造体 をお読みください。
次は Dancing Links のヘッダーを定義します。
リスト : ヘッダーの定義 (defvar *header* nil) ;;; ヘッダーの初期化 (defun init-header () (setq *header* (make-new-dnode -1)))
Dancing Links は大域変数 *header* に格納します。初期化は関数 init-header で行います。 make-new-node で空のヘッダーを生成して *header* にセットするだけです。
●Dancing Links の生成
次は Dancing Links を生成する処理を作りましょう。
リスト : dancing-links の生成
(defun make-dancing-links (xss)
(init-header)
(do ((line 0 (+ line 1))
(xss xss (cdr xss)))
((null xss))
(let ((xs (car xss))
(h-node (make-new-dnode line)))
(insert-column (car xs) h-node)
(dolist (col (cdr xs))
(let ((node (make-new-dnode line)))
(insert-column col node)
(insert-line h-node node))))))
Dancing Links は関数 make-dancing-links で生成します。引数 xss は部分集合を格納したリストです。init-header でヘッダーを初期化して、do ループで xss から部分集合を取り出して Dancing Links へ追加していきます。変数 line は行番号を、変数 xs は xss の要素 (部分集合) を表します。
最初に xs の先頭要素を表す節を make-new-node で生成し変数 h-node にセットします。横方向のリンクはヘッダーを用意しないで、h-node を行のヘッダーとして使います。それから、h-node を関数 insert-column に渡して列の末尾に挿入します。insert-column の第 1 引数が列番号、第 2 引数が挿入する節です。あとは dolist で残りの要素を取り出して節 node を生成し、insert-column で列の末尾に挿入したあと、insert-line で行の末尾に挿入します。
次は行の末尾に節を挿入する関数 insert-line を作ります。
リスト : 行の末尾に節を追加
(defun insert-line (header new-node)
(let ((p-node (dnode-prev header)))
(setf (dnode-prev new-node) p-node)
(setf (dnode-next new-node) header)
(setf (dnode-next p-node) new-node)
(setf (dnode-prev header) new-node)
new-node))
引数 header が行のヘッダー、new-node が挿入する節です。dnode-prev で header の prev にリンクされている節を求めて変数 p-node にセットします。p-node と header の間に new-node を挿入するので、new-node の prev は p-node に、next は header に書き換えます。それから、p-node の next を new-node に、header の prev を new-node に書き換えます。この操作は双方向リストのデータ挿入とまったく同じです。
次は列の末尾に節を挿入する関数 insert-column を作ります。
リスト : 列の末尾に節を追加
(defun insert-column (col new-node)
(let* ((header (search-header col))
(p-node (dnode-up header)))
(incf (dnode-len header))
(setf (dnode-header new-node) header)
(setf (dnode-down new-node) header)
(setf (dnode-up new-node) p-node)
(setf (dnode-down p-node) new-node)
(setf (dnode-up header) new-node)))
引数 col が列の番号、new-node が末尾に挿入する節です。最初に、関数 search-header で col 番目の列ヘッダーを求めて変数 header にセットします。次に、header の up にリンクされている節を求めて変数 p-node にセットします。new-node は p-node と header の間に挿入します。挿入の方法は insert-line と同じです。このとき、header の len を +1 して、new-node の header を列ヘッダーに書き換えます。
次は n 番目の列を探す関数 serach-header を作ります。
リスト : n 番目の列ヘッダーを探す
(defun search-header (n)
(do ((node (dnode-next *header*) (dnode-next node)))
((eq node *header*)
;; 新しい列ヘッダーを追加
(insert-line *header* (make-new-dnode n)))
(if (= (dnode-num node) n)
(return node))))
*header* からリンク next を順番にたどり、num の値が n のヘッダーを探します。見つからない場合は新しい列ヘッダーを *header* の末尾に追加します。列ヘッダーは *header* の横方向にリンクされているので、末尾に挿入する処理は insert-line で行うことができます。
●行と列の削除
次は Dancing Links から行と列を削除する処理を作ります。
リスト : 行と列の削除
;;; 列ヘッダーの削除
(defun remove-header (node)
(let* ((header (dnode-header node))
(p-node (dnode-prev header))
(n-node (dnode-next header)))
(setf (dnode-next p-node) n-node
(dnode-prev n-node) p-node)))
;;; 縦のリンクから外す
(defun remove-column (node)
(let ((u-node (dnode-up node))
(d-node (dnode-down node)))
(setf (dnode-down u-node) d-node
(dnode-up d-node) u-node)
(decf (dnode-len (dnode-header node)))))
;;; 行列の削除
(defun remove-matrix (h-node)
(let ((node h-node))
(loop
;; 列ヘッダーを外す
(remove-header node)
;; 縦のリンクをたどる
(do ((c-node (dnode-down node) (dnode-down c-node)))
((eq c-node node))
;; ヘッダーを除外する
(unless (eq (dnode-header c-node) c-node)
;; 横のリンクをたどる
(do ((l-node (dnode-next c-node) (dnode-next l-node)))
((eq l-node c-node))
;; 縦のリンクから外す
(remove-column l-node))))
;
(setf node (dnode-next node))
(if (eq node h-node) (return)))))
remove-matrix の引数 h-node が選択した部分集合の要素 (節) です。最初の loop で h-node の横のリンクを next 方向へたどります。ループの中で、最初に列ヘッダー header を求め、それを横のリンクから外します。この処理を関数 remove-header で行います。
次の do ループで、node の縦のリンクを down 方向へたどります。このとき、列ヘッダーをスキップすることと、節 node は縦のリンクから削除しないことに注意してください。node 以外の節を見つけたら、次の do ループで横方向のリンクを next 方向へたどります。この中で、節 l-node を縦方向のリンクから外します。この処理を関数 remove-column で行います。このとき、列ヘッダーの size を -1 することと、節 c-node は縦のリンクから外さないことに注意してください。
●行と列の復元
次は、行と列を復元する関数 restore-matrix を作ります。
リスト : 行と列の復元
;;; 列ヘッダーを戻す
(defun restore-header (node)
(let* ((header (dnode-header node))
(p-node (dnode-prev header))
(n-node (dnode-next header)))
(setf (dnode-next p-node) header
(dnode-prev n-node) header)))
;;; 縦方向のリンクに戻す
(defun restore-column (node)
(let ((u-node (dnode-up node))
(d-node (dnode-down node)))
(setf (dnode-down u-node) node
(dnode-up d-node) node)
(incf (dnode-len (dnode-header node)))))
;;; 行列の復元
(defun restore-matrix (h-node)
(let ((node (dnode-prev h-node)))
(loop
;; 列ヘッダーを戻す
(restore-header node)
;; 縦のリンクをたどる
(do ((c-node (dnode-up node) (dnode-up c-node)))
((eq c-node node))
;; ヘッダーを除外する
(unless (eq (dnode-header c-node) c-node)
;; 横のリンクをたどる
(do ((l-node (dnode-prev c-node) (dnode-prev l-node)))
((eq l-node c-node))
;; 縦のリンクに追加する
(restore-column l-node))))
;;
(if (eq node h-node) (return))
(setf node (dnode-prev node)))))
引数 h-node が選択した部分集合の要素 (節) です。remove-matrix は h-node から始めて横のリンクを next 方向へたどりました。restore-matrix は h-node の横のリンクを prev 方向へたどり、h-node を一番最後に復元します。
loop の中で、最初に列ヘッダーを横のリンクに戻します。この処理を関数 restore-header で行います。次の do ループで node の縦方向のリンクを up 方向へたどります。そして、節 c-node の横方向のリンクを prev 方向へたどります。たどる方向は remove-matrix の逆になることに注意してください。そして、節 l-node を縦のリンクに戻します。この処理を関数 restore-column で行います。このとき、列ヘッダーの size を +1 することをお忘れなく。
●Dancing Links による Algorithm X の実装
最後に、Dancing Links を使用した Algorithm X のプログラムを作ります。
リスト : Algorithm X + Dancing Links
;;; 最小の列を選択する
(defun select-min-column ()
(do* ((min-node (dnode-next *header*))
(node (dnode-next min-node) (dnode-next node)))
((eq node *header*) min-node)
(cond ((zerop (dnode-len node))
(return node))
((< (dnode-len node) (dnode-len min-node))
(setq min-node node)))))
;;; 空行列か？
(defun emptyp ()
(eq *header* (dnode-next *header*)))
;;
;; Algorithm-X + Dancing Links
;;
(defun algo-dlx-iter (f xs a)
(if (emptyp)
(funcall f a)
;; 列の選択
(let ((c-node (select-min-column)))
;; 行の選択
(do ((l-node (dnode-down c-node) (dnode-down l-node)))
((eq l-node c-node))
(remove-matrix l-node)
(algo-dlx-iter f xs (cons (aref xs (dnode-num l-node)) a))
(restore-matrix l-node)))))
(defun algo-dlx (f xs)
(make-dancing-links xs)
(algo-dlx-iter f (make-array (length xs) :initial-contents xs) nil))
関数 select-min-column は選択肢が最小の列を線形探索で求めます。関数 emptyp は列ヘッダーがなくなったときに t を返します。algo-dlx は make-dancing-links で Dancing Links を生成し、関数 algo-dlx-iter を呼び出して解を探索します。
algo-dlx-iter は簡単です。行列が空になったか emptyp でチェックします。空行列の場合、関数 f に累積変数 a を渡して呼び出します。そうでなければ、select-min-column で最小の列を選択して変数 c-node にセットします。次に do ループで c-node の縦のリンクをたどり、行 (部分集合) を選んで変数 l-node にセットします。そして、remove-matrix で l-node が属している列と行を削除し、algo-dlx-iter を再帰呼び出しします。戻ってきたら、resotre-matrix で行と列を元に戻します。
●実行結果
それでは、実行してみましょう。前回と同様に L トロミノの敷き詰め問題を解いてみました。
表 : 実行結果
盤面 | A | 総数 | AlgoX | DLX
------+----+---------+-------+------
7 * 7 | 0 | 1440 | 0.03 | 0.00
------+----+---------+-------+------
8 * 8 | 0 | 30355 | 0.62 | 0.11
------+----+---------+-------+------
9 * 9 | -- | 1193600 | 27.92 | 4.54
A : 取り除く正方形の位置
実行環境 : SBCL 2.1.11, Ubunts 22.04 (WSL2), Intel Core i5-6200U 2.30GHz
AlgoX は前回作成した immutable なデータ構造で実装した Algorithm X の結果で、DLX が今回作成した Dancing Links を用いた Algorithm X の結果です。どの盤面でも DLX のほうが速くなりました。Dancing Links の効果はとても大きいことがわかります。ところで、Common Lisp はデータ型や最適化の指定を行うことができます。最適化を指定するとすると、もう少し速くなるかもしれません。興味のある方は試してみてください。、
●参考文献, URL
- 数理パズル入門, L-トロミノの敷き詰め (リンク切れ)
- Exact cover - Wikipedia (en)
- Donald Knuth, "Dancing Links (PDF)"
- Knuth's Algorithm X - Wikipedia (en)
- Dancing Links - Wikipedia (en)
●プログラムリスト
;;;
;;; tromino1.lsp : トロミノの敷き詰め (Algorithm X + Dancing Links)
;;;
;;; Copyright (C) 2014-2023 Makoto Hiroi
;;;
;;; L-toromino の生成
(defun make-l-tromino (w h)
(let ((buff '()))
(dotimes (x (- w 1) buff)
(dotimes (y (- h 1))
(let ((z (+ (* y w) x)))
(push (list z (+ z 1) (+ z w) ) buff)
(push (list z (+ z 1) (+ z w 1)) buff)
(push (list z (+ z w) (+ z w 1)) buff)
(push (list (+ z 1) (+ z w) (+ z w 1)) buff))))))
;;;
;;; Dancing Links
;;;
;;; データ構造の定義
(defstruct dnode
up down prev next num header (len 0))
;;; ヘッダー
(defvar *header* nil)
;;; 節の生成
(defun make-new-dnode (n)
(let ((node (make-dnode :num n)))
(setf (dnode-up node) node)
(setf (dnode-down node) node)
(setf (dnode-prev node) node)
(setf (dnode-next node) node)
(setf (dnode-header node) node)
node))
;;; ヘッダーの初期化
(defun init-header ()
(setq *header* (make-new-dnode -1)))
;;; 行の末尾に追加
(defun insert-line (header new-node)
(let ((p-node (dnode-prev header)))
(setf (dnode-prev new-node) p-node)
(setf (dnode-next new-node) header)
(setf (dnode-next p-node) new-node)
(setf (dnode-prev header) new-node)
new-node))
;;; 列 n のヘッダーを探す
(defun search-header (n)
(do ((node (dnode-next *header*) (dnode-next node)))
((eq node *header*)
;; 新しいヘッダーを追加
(insert-line *header* (make-new-dnode n)))
(if (= (dnode-num node) n)
(return node))))
;;; 列の末尾に追加
(defun insert-column (col new-node)
(let* ((header (search-header col))
(p-node (dnode-up header)))
(incf (dnode-len header))
(setf (dnode-header new-node) header)
(setf (dnode-down new-node) header)
(setf (dnode-up new-node) p-node)
(setf (dnode-down p-node) new-node)
(setf (dnode-up header) new-node)))
;;; dancing-links の生成
(defun make-dancing-links (xss)
(init-header)
(do ((line 0 (+ line 1))
(xss xss (cdr xss)))
((null xss))
(let ((xs (car xss))
(h-node (make-new-dnode line)))
(insert-column (car xs) h-node)
(dolist (col (cdr xs))
(let ((node (make-new-dnode line)))
(insert-column col node)
(insert-line h-node node))))))
;;; 最小の列を選択する
(defun select-min-column ()
(do* ((min-node (dnode-next *header*))
(node (dnode-next min-node) (dnode-next node)))
((eq node *header*) min-node)
(cond ((zerop (dnode-len node))
(return node))
((< (dnode-len node) (dnode-len min-node))
(setq min-node node)))))
;;; 列ヘッダーの削除
(defun remove-header (node)
(let* ((header (dnode-header node))
(p-node (dnode-prev header))
(n-node (dnode-next header)))
(setf (dnode-next p-node) n-node
(dnode-prev n-node) p-node)))
;;; 縦のリンクから外す
(defun remove-column (node)
(let ((u-node (dnode-up node))
(d-node (dnode-down node)))
(setf (dnode-down u-node) d-node
(dnode-up d-node) u-node)
(decf (dnode-len (dnode-header node)))))
;;; 行と列の削除
(defun remove-matrix (h-node)
(let ((node h-node))
(loop
;; 列ヘッダーを外す
(remove-header node)
;; 縦方向のリンクをたどる
(do ((c-node (dnode-down node) (dnode-down c-node)))
((eq c-node node))
;; ヘッダーを除外する
(unless (eq (dnode-header c-node) c-node)
;; 横方向のリンクをたどる
(do ((l-node (dnode-next c-node) (dnode-next l-node)))
((eq l-node c-node))
;; 縦のリンクから外す
(remove-column l-node))))
;;
(setf node (dnode-next node))
(if (eq node h-node) (return)))))
;;; 列ヘッダーを戻す
(defun restore-header (node)
(let* ((header (dnode-header node))
(p-node (dnode-prev header))
(n-node (dnode-next header)))
(setf (dnode-next p-node) header
(dnode-prev n-node) header)))
;;; 縦方向のリンクに戻す
(defun restore-column (node)
(let ((u-node (dnode-up node))
(d-node (dnode-down node)))
(setf (dnode-down u-node) node
(dnode-up d-node) node)
(incf (dnode-len (dnode-header node)))))
;;; 行と列の復元
(defun restore-matrix (h-node)
(let ((node (dnode-prev h-node)))
(loop
;; 列ヘッダーを戻す
(restore-header node)
;; 縦方向のリンクをたどる
(do ((c-node (dnode-up node) (dnode-up c-node)))
((eq c-node node))
;; ヘッダーを除外する
(unless (eq (dnode-header c-node) c-node)
;; 横方向のリンクをたどる
(do ((l-node (dnode-prev c-node) (dnode-prev l-node)))
((eq l-node c-node))
;; 縦のリンクに追加する
(restore-column l-node))))
;;
(if (eq node h-node) (return))
(setf node (dnode-prev node)))))
;;; 空行列か？
(defun emptyp ()
(eq *header* (dnode-next *header*)))
;;;
;;; Algorithm-X + Dancing Links
;;;
(defun algo-dlx-iter (f xs a)
(if (emptyp)
(funcall f a)
;; 列の選択
(let ((c-node (select-min-column)))
;; 行の選択
(do ((l-node (dnode-down c-node) (dnode-down l-node)))
((eq l-node c-node))
(remove-matrix l-node)
(algo-dlx-iter f xs (cons (aref xs (dnode-num l-node)) a))
(restore-matrix l-node)))))
(defun algo-dlx (f xs)
(make-dancing-links xs)
(algo-dlx-iter f (make-array (length xs) :initial-contents xs) nil))
;;;
;;; L-tromino の敷き詰め
;;;
;;; n * n - 1
(defun solver-l-tromino-1-dlx (f n m)
(algo-dlx f (remove-if #'(lambda (xs) (member m xs))
(make-l-tromino n n))))
;;; n * n
(defun solver-l-tromino-dlx (f n)
(algo-dlx f (make-l-tromino n n)))
改訂 2023 年 7 月 15 日