ラベル 無限クイーン の投稿を表示しています。 すべての投稿を表示
ラベル 無限クイーン の投稿を表示しています。 すべての投稿を表示

2020年12月10日木曜日

無限クイーン

TAOCPの演習問題7221-38に, 無限クイーン列<qn>の効率的計算法を考案せよというのがある.

面白い解答なので, その説明をしたい.

二進の配列 a,b,cを使う. cは正と負の添字がある.
G1. [初期化.] r←0, s←1, t←0, n←0とする. ( 1≤k≤nについて, qkの計算が済んだ.)
G2. [qn≤nを調べる.] (この時点で1≤k<sについて ak=1でa2=0; また-r<k≤tについてck=1 でc-r=ct+1=0; 各ベクターにはn個の1がある.) n←n+1, k←sとする.
G3. [見つけた?] ak=bk+n=ck-n=0なら G5へ進む. そうでないなら, k←k+1とし, k≤n-rならこのステップを繰り返す.
G4. [qn>nを作る.] t←t+1; qn←n+t; ak←b2n+t←ct←1とし, G2へ戻る.
G5. [qn≤nを作る.] qn←k; ak←bk+n←ck-n←1とする. k=sなら, as=0になるまでs←s+1を繰り返す. k=n-rなら c-r=0になるまでr←r+1を繰り返す. G2へ戻る.

このプログラムを忠実に辿ると, 大体こういうことをやっていると判明する.

TAOCPのプログラムでは, チェス盤の行も列も1から始めるが, 私はやはり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

のように始まる. その始めの方の置きかたを見ると(下の図 前回の図では, 行は下に 延びていたのに, 今回は逆に上に延びるように描いて申し訳けない.)

まず列n=0は行0にクイーンが置ける. それが左下の黒丸だ. そうするとどの行にはもう置けない ことを示す配列aの0を1に, 行-列の対角線に置けないことを示す配列cの0-0=0を1にする. 図ではそれを黒丸のすぐ右の青小丸とすぐ右上の赤小丸で示す. 配列bも0+0=0が 1になるがそれは図には示さない.

続いてn=1にクイーンを置くのだが, 青線が示すようにこの行には置けず, 赤の対角線が 示すようにこの斜線にも置けない. よって赤斜線の上のq=2に置くことになる. それが (1,2)の黒丸で, その右の青小丸と右上の赤小丸で配列の設定も分る.

n=2の列は, 行0は青線でだめ, 行2は赤線でだめ, その間の行1は, すぐ左上にクイーン がいてだめ(これは配列bで分る). 行4も(1,2)からの斜線のためだめで, 結局 行4に置く.

このようにして置いていくのだが, 青線はこれより下はすべて詰っている; 2本の赤線は この間はすべて詰っていることを示す. したがって行0の青線は, 列3の行1に置くと 行2まで詰ったので, ここからは行2から横に進む.

赤の斜線も同様に出来ている. 従ってある列でクイーンが置けるか調べるには, 青線路 の上から始め, 下の赤線の下までである. ここまでで配列a, b, cを調べ, 置けない 時は, 上の赤線の上に置くことになる.

この方針で私流に書いたプログラムが次だ.
(define qs (make-list 30))
(define as (make-list 50 0))
(define bs (make-list 80 0))
(define cs (make-list 40 0))
(define coff 20)
(define (a k) (list-ref as k))
(define (b k) (list-ref bs k))
(define (c k) (list-ref cs (+ k coff)))
(define (a! k) (list-set! as k 1))
(define (b! k) (list-set! bs k 1))
(define (c! k) (list-set! cs (+ k coff) 1))
(define (place k) (list-set! qs n k)
 (a! k) (b! (+ k n)) (c! (- k n)))
(define n 0) (define s -1) (define t 0) (define r 0)
(define k)
(while (< n 30) (set! k (+ s 1))
 (while 
  (and (< k (+ n r))
   (or (= (a k) 1) (= (b (+ k n)) 1) (= (c (- k n)) 1)))
  (set! k (+ k 1)))
 (if (and (= (a k) 0) (= (b (+ k n)) 0)
  (= (c (- k n)) 0))
  (begin (place k)
   (while (= (a (+ s 1)) 1) (set! s (+ s 1)))  
   (while (= (c (- r 1)) 1) (set! r (- r 1))))
  (begin (place (+ n t 1)) (set! t (+ t 1))))
 (set! n (+ n 1)))
qs

=>(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)	  
変数sは青線を, rは下の赤線を, tは右の赤線を示す. これは最初のTAOCPのプログラムと 同じである. 変数kの使い方も同様.

下の図は, 上のと同じだが, nの範囲を広げた. また配列を調べた位置を白丸で示した. 白丸の数が少ないことに注目して欲しい. TAOCPのプログラムは判定の方法が違うので, 白丸の数はこれよりかなり多い.


2020年11月10日火曜日

無限クイーン

TAOCPのV4F5に,
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+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)からは同じ