1,3,5,2,4,9,11,13,15,6,8,19,7,22,10,25,27,29,31,12,14,35,37,39, 41,16,18,45,...という数列があり, これは「無限クイーン」の辞書式順で最小の解とあった(演習問題 7221-42). これを計算してみたというのが今回の話題だ.
情報科学の標準問題のひとつに8クイーンがある. チェス盤の上に, 飛車と角行を併せて動くクイーンを8個, 互いに当らないように置く方法を求める問題だ. その8を無限大にしたのが「無限クイーン」である. つまり縦横とも半無限に広いチェス盤に, 孫悟空の分身の術のように無限に現れるクイーンを置くのである.
釈迦に説法かも知れないが, 順序としてまず8クイーンの解法を復習しよう. 次の図を見て欲しい.
8×8のチェス盤の列にも行にも0から7の番号をつける. そして左端の列0からクイーンの 置けるところを探す. 既に置いてあるクイーンと当らないようにということは, 置く場合, その行には他のクイーンはない; その場所の右上がりの筋には他のクイーンはいない. その場所の右下がりの筋には他のクイーンはいない. という条件が揃えばそこに 新しいクイーンが置けて, さらに右の列の検討が始まる.
その列のどの行にも上の条件の場所がなければ, 1列戻って, その列のクイーンを更に下に 置けるかどうか調べる. こうして8個置くことが出来れば解である. 一つの解が見付かっても, まだ他の解を探すのが全解探索だ.
上のような戦術で8クイーンを探すプログラムを示すと次のようになる.
この行, この右上がりの筋, この右下がりの筋にまだクイーンが置けることを示す配列 as, bs, csを用意する. 真理値が入る. 最初はどこにでも置けるから, 初期値は真だ.
列の添字をm, 行の添字をnとすると, 右上がりの筋はm+n=一定, 右下がりはm-n=一定で, mもnも0から7の値をとるから, m+nの値は0から14, m-nの値は-7から7である. 配列の添字は0以上なので, 右下がりはm-n+7の場所に置く.
各列の置き方を調べる関数が col m で, その下請けの各行の置き方を調べるのが row n である.
(define qs (make-list 8 '()))
(define as (make-list 8 #t))
(define bs (make-list 15 #t))
(define cs (make-list 15 #t))
(define (col m)
(define (row n)
(if (< n 8) (begin
(if (and (list-ref as n) (list-ref bs (+ m n))
(list-ref cs (- m n -7)))
(begin (list-set! qs m n) (list-set! as n #f)
(list-set! bs (+ m n) #f)
(list-set! cs (- m n -7) #f) (col (+ m 1))
(list-set! cs (- m n -7) #t)
(list-set! bs (+ m n) #t) (list-set! as n #t)
(list-set! qs m '())))
(row (+ n 1)))))
(if (< m 8) (row 0) (display qs)))
(col 0)
このプログラムはバックトラックを繰り返す. 最初の解が得られるまでのバックトラック
の様子を見ると下のようだ. 
そうして得られた92通りの解答は次の通り.
(0 4 7 5 2 6 1 3)(0 5 7 2 6 3 1 4)(0 6 3 5 7 1 4 2) (0 6 4 7 1 3 5 2)(1 3 5 7 2 0 6 4)(1 4 6 0 2 7 5 3) (1 4 6 3 0 7 5 2)(1 5 0 6 3 7 2 4)(1 5 7 2 0 3 6 4) (1 6 2 5 7 4 0 3)(1 6 4 7 0 3 5 2)(1 7 5 0 2 4 6 3) (2 0 6 4 7 1 3 5)(2 4 1 7 0 6 3 5)(2 4 1 7 5 3 6 0) (2 4 6 0 3 1 7 5)(2 4 7 3 0 6 1 5)(2 5 1 4 7 0 6 3) (2 5 1 6 0 3 7 4)(2 5 1 6 4 0 7 3)(2 5 3 0 7 4 6 1) (2 5 3 1 7 4 6 0)(2 5 7 0 3 6 4 1)(2 5 7 0 4 6 1 3) (2 5 7 1 3 0 6 4)(2 6 1 7 4 0 3 5)(2 6 1 7 5 3 0 4) (2 7 3 6 0 5 1 4)(3 0 4 7 1 6 2 5)(3 0 4 7 5 2 6 1) (3 1 4 7 5 0 2 6)(3 1 6 2 5 7 0 4)(3 1 6 2 5 7 4 0) (3 1 6 4 0 7 5 2)(3 1 7 4 6 0 2 5)(3 1 7 5 0 2 4 6) (3 5 0 4 1 7 2 6)(3 5 7 1 6 0 2 4)(3 5 7 2 0 6 4 1) (3 6 0 7 4 1 5 2)(3 6 2 7 1 4 0 5)(3 6 4 1 5 0 2 7) (3 6 4 2 0 5 7 1)(3 7 0 2 5 1 6 4)(3 7 0 4 6 1 5 2) (3 7 4 2 0 6 1 5)(4 0 3 5 7 1 6 2)(4 0 7 3 1 6 2 5) (4 0 7 5 2 6 1 3)(4 1 3 5 7 2 0 6)(4 1 3 6 2 7 5 0) (4 1 5 0 6 3 7 2)(4 1 7 0 3 6 2 5)(4 2 0 5 7 1 3 6) (4 2 0 6 1 7 5 3)(4 2 7 3 6 0 5 1)(4 6 0 2 7 5 3 1) (4 6 0 3 1 7 5 2)(4 6 1 3 7 0 2 5)(4 6 1 5 2 0 3 7) (4 6 1 5 2 0 7 3)(4 6 3 0 2 7 5 1)(4 7 3 0 2 5 1 6) (4 7 3 0 6 1 5 2)(5 0 4 1 7 2 6 3)(5 1 6 0 2 4 7 3) (5 1 6 0 3 7 4 2)(5 2 0 6 4 7 1 3)(5 2 0 7 3 1 6 4) (5 2 0 7 4 1 3 6)(5 2 4 6 0 3 1 7)(5 2 4 7 0 3 1 6) (5 2 6 1 3 7 0 4)(5 2 6 1 7 4 0 3)(5 2 6 3 0 7 1 4) (5 3 0 4 7 1 6 2)(5 3 1 7 4 6 0 2)(5 3 6 0 2 4 1 7) (5 3 6 0 7 1 4 2)(5 7 1 3 0 6 4 2)(6 0 2 7 5 3 1 4) (6 1 3 0 7 4 2 5)(6 1 5 2 0 3 7 4)(6 2 0 5 7 4 1 3) (6 2 7 1 4 0 5 3)(6 3 1 4 7 0 2 5)(6 3 1 7 5 0 2 4) (6 4 2 0 5 7 1 3)(7 1 3 0 6 4 2 5)(7 1 4 2 0 6 3 5) (7 2 0 5 1 4 6 3)(7 3 0 2 5 1 6 4)ところで, MIT Schemeにはbit stringというデータの型があり, Eratosthenesの篩の ような真理値の配列に便利である. 今回使う関数を説明すると
(make-bit-string 8 #t)
各ビットが1の8ビットのbit stringを生成する. #fなら0になる.
(bit-string-ref bs k)
bit string bsのk番目のビットを調べる. 0なら#f, 1なら#tが返る.
(bit-string-set! as k)
bit string asのk番目のビットを1にする.
(bit-string-clear! as k)
bit string asのk番目のビットを0にする. bit stringにはある範囲で 最初の1の位置を探す飛道具がある.
(bit-string-find-next-set-bit as k 8)
bit string asの[k .. 8)の間で, 最初の1であるビットの位置を返す. 1がなければ#fを返す.
(bit-string-append as bs)
bit string asとbsを接続した新しいbit stringを返す. as内のビット番号は不変. 新しい bsの部分の番号は前の番号にasの長さを足したものになる.
bit stringを使った8クイーンのプログラムは次のようだ. as, bs, csはどの位置にも クイーンが置けるから#t, つまり1にしておく. bit stringからビットを取り出すのは (b k)はbsのkビットを返す. (as k)はasのkからの最初の#tの位置を返す. ビットの設定は(a~ k)はasのkビットを0に, (a! k)はasのkビットを1にする.
(define qs (make-list 8 '()))
(define as (make-bit-string 8 #t))
(define bs (make-bit-string 15 #t))
(define cs (make-bit-string 15 #t))
(define (a k) (bit-substring-find-next-set-bit as k 8))
(define (b k) (bit-string-ref bs k))
(define (c k) (bit-string-ref cs (+ k 7)))
(define (a! k) (bit-string-set! as k))
(define (b! k) (bit-string-set! bs k))
(define (c! k) (bit-string-set! cs (+ k 7)))
(define (a~ k) (bit-string-clear! as k))
(define (b~ k) (bit-string-clear! bs k))
(define (c~ k) (bit-string-clear! cs (+ k 7)))
(define (col m)
(define (row n)
(let ((n1 (a n)))
(if n1 (begin
(if (and (b (+ m n1)) (c (- m n1))) (begin
(list-set! qs m n1) (a~ n1) (b~ (+ m n1))
(c~ (- m n1)) (col (+ m 1)) (c! (- m n1))
(b! (+ m n1)) (a! n1) (list-set! qs m '())))
(row (+ n1 1))))))
(if (< m 8) (row 0) (display qs)))
(col 0)
これで様子が分ったから, 無限クイーンに取り掛かろう. 問題はcのbit stringで,
0がbit stringの途中にあるので, オフセットを足すことだ.
無限クイーンでいいのは, 列の中で次に置ける位置はどんどん先まで探せばよく, バックトラック
しないことだ. 従って#tに戻す(a! k)のような関数はない. 無限といっても無限まで
計算することはないので, 列の最大番号はきめることにした. mmaxの値である.
するとas, bs, csなどの長さも余裕をもって決められる.
(define mmax 256)
(define nmax (* mmax 2))
(define qmax mmax)
(define amax nmax)
(define bmax (+ mmax nmax))
(define cmax (+ mmax nmax))
(define qs (make-list qmax '()))
(define as (make-bit-string amax #t))
(define bs (make-bit-string bmax #t))
(define cs (make-bit-string cmax #t))
(define (a k)
(bit-substring-find-next-set-bit as k amax))
(define (b k) (bit-string-ref bs k))
(define (c k) (bit-string-ref cs (+ k nmax)))
(define (a~ k) (bit-string-clear! as k))
(define (b~ k) (bit-string-clear! bs k))
(define (c~ k) (bit-string-clear! cs (+ k nmax)))
(define (q! m n) (list-set! qs m n))
(define (col m)
(define (row n)
(let ((n1 (a n)))
(if (and (b (+ m n1)) (c (- m n1)))
(begin (q! m n1) (a~ n1) (b~ (+ m n1))
(c~ (- m n1)) (col (+ m 1)))
(row (+ n1 1)))))
(if (< m mmax) (row 0) (display (take m qs))))
(col 0)
実行結果を下に示す.
(0 2 4 1 3 8 10 12 14 5 7 18 6 21 9 24 26 28 30 11 13 34 36 38 40 15 17 44 16 47 19 50 52 20 55 57 59 22 62 23 65 27 25 69 71 73 75 77 29 31 81 83 85 32 88 33 91 37 35 95 97 99 101 39 104 106 41 109 42 112 43 115 117 119 45 122 46 49 126 48 129 131 133 135 51 53 139 141 143 54 56 147 149 151 58 154 156 158 60 161 61 64 165 63 168 170 172 66 175 177 67 180 68 183 185 70 74 189 191 72 194 196 76 199 201 203 205 78 80 209 211 79 82 215 217 84 220 222 224 226 86 229 87 90 233 89 236 238 240 242 92 94 246 93 249 96 252 254 256 98 259 261 100 264 266 268 102 271 103 274 107 105 278 280 282 284 108 110 288 290 292 111 113 296 298 300 114 116 304 306 308 310 118 120 314 316 318 121 123 322 324 326 124 329 125 128 333 127 336 338 340 342 130 132 346 348 350 352 134 136 356 358 360 137 363 138 366 142 140 370 372 374 376 378 144 146 382 384 145 148 388 390 150 393 395 397 399 152 402 153 405 407 155 159 411 413)
TAOCPにはqnはnφ+O(1)か n/φ+O(1)と書いてあったので, 図にしてみた. 赤線が黄金比の傾きの斜線だ.
上のプログラムは, as, bs, などが最初から固定長であった. これを最初はある程度に とり, 必要に応じて長くするように書いたのが次のプログラムだ. 上のと違う部分だけ 書いておく.
(define mmax 8) (define nmax (* mmax 2))
(define qmax nmax) (define amax nmax)
(define bmax (+ mmax nmax)) (define cmax (+ mmax nmax))
(define coff nmax)
(define qs (make-list qmax '()))
(define as (make-bit-string amax #t))
(define bs (make-bit-string bmax #t))
(define cs (make-bit-string cmax #t))
(define (a k) (let
((k1 (bit-substring-find-next-set-bit as k amax)))
(if k1 k1 (begin
(set! as (bit-string-append as
(make-bit-string amax #t)))
(set! amax (* amax 2)) (a k)))))
(define (b k) (if (>= k bmax) (begin
(set! bs (bit-string-append bs
(make-bit-string bmax #t)))
(set! bmax (* bmax 2))))
(bit-string-ref bs k))
(define (c k)
(if (or (>= (+ k coff) cmax) (< (+ k coff) 0)) (begin
(set! cs (bit-string-append
(bit-string-append (make-bit-string (/ cmax 2) #t)
cs) (make-bit-string (/ cmax 2) #t)))
(set! coff (+ coff (/ cmax 2)))
(set! cmax (* cmax 2))))
(bit-string-ref cs (+ k coff)))
(define (q! m n) (if (>= m qmax) (begin
(set! qs (append qs (make-list qmax '())))
(set! qmax (* qmax 2))))
(list-set! qs m n))
この下 (a~ k), (b~ k)からは同じ