Lisp / Scheme の場合、データ構造を表すのにリストがよく使われます。ところが、問題によってはリストよりもビットで表した方が、プログラムを作るのに都合がよい場合もあります。ビット演算の規定は R7RS-small にはありませんが、R7RS-large ではライブラリ (scheme bitwise) に規定されています。
Gauche は (scheme bitwise) をサポートしていますが、このほかに Common Lisp ライクなビット演算も用意されています。今回は (scheme bitwise) に用意されているビット演算の基本的な使い方を説明します。
基本的な論理演算を行う主な関数を下表に示します。
| 関数名 | 機能 |
|---|---|
| bitwise-and n ... | ビットごとの論理積を返す (logand と同じ) |
| bitwise-ior n ... | ビットごとの論理和を返す (logior と同じ) |
| bitwise-xor n ... | ビットごとの排他的論理和を返す (logxor と同じ) |
| bitwise-not n | ビットごとの論理的な否定を返す (lognot と同じ) |
bitwise-and は引数に対するビットごとの論理積を返します。もし引数が与えられなければ -1 を返します。
gosh[r7rs.user]> (import (scheme bitwise)) gosh[r7rs.user]> (bitwise-and #b0101 #b0011) 1
#b0101
and #b0011
-----------
#b0001
bitwise-ior は引数に対するビットごとの論理和を返します。もし引数が与えられなければ 0 を返します。
gosh[r7rs.user]> (bitwise-ior #b0101 #b0011) 7
#b0101
or #b0011
----------
#b0111
bitwise-xor は引数に対するビットごとの排他的論理和を返します。もし引数が与えられなければ 0 を返します。
gosh[r7rs.user]> (bitwise-xor #b0101 #b0011) 6
#b0101
xor #b0011
-----------
#b0110
bitwise-not は引数に対するビットごとの論理的な否定を返します。
gosh[r7rs.user]> (bitwise-not 0) -1 ; #b1111 .... 1111 gosh[r7rs.user]> (bitwise-and 0 -1) 0 gosh[r7rs.user]> (bitwise-not 1) -2 ; #b1111 .... 1110 gosh[r7rs.user]> (bitwise-and 1 -2) 0
基本的なビット操作関数を下表に示します。
| 関数名 | 機能 |
|---|---|
| any-bit-set? mask n | (not (zero? (bitwise-and mask n))) と同じ (logtest とほぼ同じ) |
| every-bit-set? mask n | (= (bitwise-and mask n) mask) と同じ |
| bit-set? index n | index 番目のビットが 1 ならば真を返す (logbit? と同じ) |
| bit-count n | n が正ならば 1 のビットの数を、負ならば 0 のビットの数を返す (logcount と同じ) |
| arithmetic-shift n count | count が正ならば count ビットだけ左シフト、負ならば右シフトする (ash と同じ) |
any-bit-set? と every-bit-set? は引数 mask と n の論理積を計算します。any-bit-set? は結果が 0 でなければ真を返します。つまり、n のビットが mask と同じ位置に一つでも立っていれば真を返します。every-bit-set? は結果が mask と同じ値であれば心を返します。つまり、mask と同じ位置にある n のビットがすべて立っていれば真を返します。
gosh[r7rs.user]> (any-bit-set? #b0101 #b0011) #t gosh[r7rs.user]> (any-bit-set? #b0101 #b0010) #f gosh[r7rs.user]> (every-bit-set? #b0101 #b0101) #t gosh[r7rs.user]> (every-bit-set? #b0101 #b0011) #f
bit-set? は添字 index の位置にある n のビットが 1 ならば #t を返します。逆に 0 ならば #f を返します。ビットの位置は配列と同じく 0 から数えます。
gosh[r7rs.user]> (bit-set? 0 #b0101) #t gosh[r7rs.user]> (bit-set? 1 #b0101) #f
bit-count は n が正の値であれば 1 のビットを数えて返します。負の値であれば 0 のビットを数えて返します。
gosh[r7rs.user]> (bit-count 13) 3 ; #b...0001101 gosh[r7rs.user]> (bit-count -13) 2 ; #b...1110011
arithmetic-shift は n を count ビット左シフトします。下位ビットには 0 が挿入されます。count が負の値であれば count ビット右シフトします。この場合、正の整数では上位ビットに 0 が挿入されます。負の整数では 1 が挿入されます。これを「算術シフト」といいます。
gosh[r7rs.user]> (arithmetic-shift 1 8) 256 gosh[r7rs.user]> (arithmetic-shift -1 8) -256 gosh[r7rs.user]> (arithmetic-shift 256 -8) 1 gosh[r7rs.user]> (arithmetic-shift -256 -8) -1
ビット演算の簡単な例題として、N 通りある組み合わせに 0 から N - 1 までの番号を付ける方法を紹介しましょう。たとえば、6 個の中から 3 個を選ぶ組み合わせは 20 通りありますが、この組み合わせに 0 から 19 までの番号を付けることができます。1 1 1 0 0 0 を例題に考えてみましょう。次の図を見てください。
5 4 3 2 1 0
─────────
0 0 0 1 1 1 ↑
0 0 1 0 1 1 │
0 0 1 1 0 1 │
0 0 1 1 1 0 │
0 1 0 0 1 1 │
0 1 0 1 0 1 5Ｃ3 = 10 通り
0 1 0 1 1 0 │
0 1 1 0 0 1 │
0 1 1 0 1 0 │
0 1 1 1 0 0 ↓
─────────
1 0 0 0 1 1 ↑
1 0 0 1 0 1 │
1 0 0 1 1 0 │
1 0 1 0 0 1 4Ｃ2 = 6 通り
1 0 1 0 1 0 │
1 0 1 1 0 0 ↓
────────
1 1 0 0 0 1 ↑
1 1 0 0 1 0 3Ｃ1 = 3 通り
1 1 0 1 0 0 ↓
───────
1 1 1 0 0 0 19 番目
─────────
図 : 6Ｃ3 の組み合わせ
最初に 5 をチェックします。5 を選ばない場合は \({}_5 \mathrm{C}_3\) = 10 通りありますね。この組み合わせに 0 から 9 までの番号を割り当てることにすると、5 を選ぶ組み合わせの番号は 10 から 19 までとなります。
次に、4 をチェックします。4 を選ばない場合は、\({}_4 \mathrm{C}_2\) = 6 通りあります。したがって、5 を選んで 4 を選ばない組み合わせに 10 から 15 までの番号を割り当てることにすると、5 と 4 を選ぶ組み合わせには 16 から 19 までの番号となります。
最後に、3 をチェックします。同様に 3 を選ばない場合は 3 通りあるので、これに 16 から 18 までの番号を割り当て、5, 4, 3 を選ぶ組み合わせには 19 を割り当てます。これで組み合わせ 1 1 1 0 0 0 の番号を求めることができました。
では、0 0 0 1 1 1 はどうなるのでしょうか。左から順番にチェックしていくと、最初の 1 が見つかった時点で、その数字を選ばない組み合わせは存在しません。つまり、残りの数字をすべて選ぶしかないわけです。したがって、これが 0 番目となります。
このように、数字を選ぶときに、数字を選ばない場合の組み合わせの数を足し算していけば、その組み合わせの番号を求めることができるのです。プログラムは次のようになります。
リスト : 組み合わせに番号を付ける
;;; 組み合わせの数
(define (comb n r)
(if (or (zero? r) (= n r))
1
(/ (* (comb n (- r 1)) (+ (- n r) 1)) r)))
;;; 組み合わせに番号を付ける
(define (comb-to-num n r c)
(define (comb-sub n r c v)
(cond
((or (zero? r) (= n r)) v)
((bit-set? (- n 1) c)
(comb-sub (- n 1) (- r 1) c (+ (comb (- n 1) r) v)))
(else
(comb-sub (- n 1) r c v))))
;;
(comb-sub n r c 0))
関数 comb-to-num は n 個の中から r 個を選ぶ組み合わせ c を番号に変換します。実際の処理は局所関数 comb-sub で行います。
comb-sub は c の上位ビットから順番にチェックしていきます。n 個の中から r 個を選ぶ場合、n - 1 番目のビットが 1 であれば \({}_{n-1} \mathrm{C}_r\) の値を v に加算して comb-sub を再帰呼び出しします。このとき、n 個の中から一つ選んだので、r の値を -1 することをお忘れなく。ビットが 0 であれば、v の値はそのままで comb-sub を再帰呼び出しします。n = r または r = 0 になったら v を返します。これが再帰呼び出しの停止条件になります。
次は、番号から組み合わせを求める関数 num-to-comb を作ります。次のリストを見てください。
リスト : 番号から組み合わせを求める
(define (num-to-comb n r v)
(define (comb-sub n r v c)
(if (= n r)
(bitwise-ior (- (expt 2 n) 1) c)
(let ((k (comb (- n 1) r)))
(if (>= v k)
(comb-sub (- n 1) (- r 1) (- v k) (bitwise-ior (arithmetic-shift 1 (- n 1)) c))
(comb-sub (- n 1) r v c)))))
;;
(comb-sub n r v 0))
関数 num-to-comb は組み合わせ \({}_n \mathrm{C}_r\) の番号 v を組み合わせ c に変換します。実際の処理は局所関数 comb-sub で行います。
comb-sub は組み合わせ c の上位ビットから決定していきます。たとえば、n = 6, r = 3 の場合、ビットが 1 になるのは \({}_5 \mathrm{C}_2\) = 10 通りあり、0 になるのは \({}_5 \mathrm{C}_3\) = 10 通りあります。したがって、数値が 0 - 9 の場合はビットを 0 に、10 - 19 の場合はビットを 1 にします。
ビットを 0 にした場合、残りは \({}_5 \mathrm{C}_3\) = 10 通りになるので、同様に次のビットを決定します。ビットを 1 にした場合、残りは \({}_5 \mathrm{C}_2\) = 10 通りになります。数値から \({}_5 \mathrm{C}_3\) = 10 を引いて次のビットを決定します。
プログラムでは、\({}_{n-1} \mathrm{C}_r\) の値を関数 comb で求めて変数 k にセットします。v が k 以上であれば c の n - 1 番目のビットを 1 にセットし、v から k を引き算します。そして、次のビットを決めればいいわけです。r = 0 になったら c を返します。また、r が n と等しくなったら、c の残りのビットを全て 1 にセットした値を返します。
それでは実際に試してみましょう。
リスト : 簡単なテスト
(define (test n r)
(let ((m (comb n r)))
(do ((i 0 (+ i 1)))
((>= i m))
(display i) (display " => ")
(let ((j (num-to-comb n r i)))
(display j) (display " => ")
(display (comb-to-num n r j))
(newline)))))
gosh[r7rs.user]> (test 5 3) 0 => 7 => 0 1 => 11 => 1 2 => 13 => 2 3 => 14 => 3 4 => 19 => 4 5 => 21 => 5 6 => 22 => 6 7 => 25 => 7 8 => 26 => 8 9 => 28 => 9 #t gosh[r7rs.user]> (test 6 3) 0 => 7 => 0 1 => 11 => 1 2 => 13 => 2 3 => 14 => 3 4 => 19 => 4 5 => 21 => 5 6 => 22 => 6 7 => 25 => 7 8 => 26 => 8 9 => 28 => 9 10 => 35 => 10 11 => 37 => 11 12 => 38 => 12 13 => 41 => 13 14 => 42 => 14 15 => 44 => 15 16 => 49 => 16 17 => 50 => 17 18 => 52 => 18 19 => 56 => 19 #t
正常に動作していますね。この方法を使うと、n 個ある組み合わせの中の i 番目 (0 <= i < n) の組み合わせを簡単に求めることができます。
最も右側 (LSB 側) にある 1 を 0 にクリアする、逆に最も右側にある 0 を 1 にセットすることは簡単にできます。
(1) 右側にある 1 をクリア => x AND (x - 1) x : 1 1 1 1 x - 1 : 1 1 1 0 ---------------- AND : 1 1 1 0 x : 1 0 0 0 x - 1 : 0 1 1 1 ---------------- AND : 0 0 0 0 (2) 右側にある 0 を 1 にセット => x OR (x + 1) x : 0 0 0 0 x + 1 : 0 0 0 1 ---------------- OR : 0 0 0 1 x : 0 1 1 1 x + 1 : 1 0 0 0 ---------------- OR : 1 1 1 1
上図 (1) を見てください。x から 1 を引くと、右側から連続している 0 は桁借りにより 1 になり、最初に出現する 1 が 0 になります。したがって、x AND (x - 1) を計算すると、最も右側にある 1 を 0 にクリアすることができます。(2) の場合、x に 1 を足すと、右側から連続している 1 は桁上がりにより 0 になり、最初に出現する 0 が 1 になります。x OR (x + 1) を計算すれば、最も右側にある 0 を 1 にセットすることができます。
また、最も右側にある 1 を取り出すことも簡単にできます。簡単な例として 4 ビットの整数値を考えてみます。負の整数を 2 の補数で表した場合、4 ビットで表される整数は -8 から 7 になります。次の図を見てください。
0 : 0000
1 : 0001 -1 : 1111 1 AND (-1) => 0001
2 : 0010 -2 : 1110 2 AND (-2) => 0010
3 : 0011 -3 : 1101 3 AND (-3) => 0001
4 : 0100 -4 : 1100 4 AND (-4) => 0100
5 : 0101 -5 : 1011 5 AND (-5) => 0001
6 : 0110 -6 : 1010 6 AND (-6) => 0010
7 : 0111 -7 : 1001 7 AND (-7) => 0001
-8 : 1000
図 : 最も右側にある 1 を取り出す方法
2 の補数はビットを反転した値 (1 の補数) に 1 を加算することで求めることができます。したがって、x と -x の論理積 x AND (-x) は、最も右側にある 1 だけが残り、あとのビットはすべて 0 になります。
さらに、最も右側にある 1 の位置 (添字) を求めることも簡単です。ビットを取り出してその値を -1 すると、下位ビットには 1 が並びます。あとは bit-count で 1 の個数を数えるだけです。簡単な例を示しましょう。
gosh[r7rs.user]> (bit-count (- 1 1)) 0 gosh[r7rs.user]> (bit-count (- 256 1)) 8 gosh[r7rs.user]> (bit-count (- 65536 1)) 16
なお、ライブラリ (scheme bitwise) には最も右側にある 1 の位置を求める関数 first-set-bit が用意されています。
gosh[r7rs.user]> (first-set-bit 1) 0 gosh[r7rs.user]> (first-set-bit 256) 8 gosh[r7rs.user]> (first-set-bit 65536) 16
もう一つ簡単な例題として、Puzzel DE Programming で取り上げた「ライツアウト」というパズルを Scheme で解いてみましょう。ライツアウトは光っているボタンをすべて消すことが目的のパズルです。ルールはとても簡単です。あるボタンを押すと、そのボタンと上下左右のボタンの状態が反転します。つまり、光っているボタンは消灯し消えていたボタンは点灯します。次の図を見てください。
□□□□□ □□□□□ ０ １ ２ ３ ４
□□□□□ □□■□□ ５ ６ ７ ８ ９
□□□□□ ─→ □■■■□ 10 11 12 13 14
□□□□□ □□■□□ 15 16 17 18 19
□□□□□ □□□□□ 20 21 22 23 24
(A) 中央のボタンを押した場合 (B) 座標
図 : ライツアウトの点灯パターン
ボタンは 5 行 5 列に配置されています。上図に示したように、中央のボタン 12 を押すとそのボタンと上下左右のボタンの状態が反転します。
ライツアウトはライトオン・オフの 2 種類の状態しかないので、盤面はリストよりもビットを使って表した方が簡単です。ライトオン・オフの状態を 1 と 0 で表し、各ビットとボタンの座標を対応させると、盤面は 0 から 33554431 の整数値で表すことができます。
ボタンを押してライトの状態を反転する処理も簡単です。たとえば、中央のボタン 12 を押した場合、7, 11, 12, 13, 17 のライトを反転させます。この場合、5 つのボタンのビットをオンにした値 #x23880 と、盤面を表す整数値の排他的論理和 (xor) を求めれば、5 つのライトの状態を反転することができます。次の例を見てください。
0 xor #x23880 => #x23880 ; 消灯の状態でボタン 12 を押す（点灯する） #x23880 xor #x23880 => 0 ; もう一度同じボタンを押す（消灯する）
このように、ライツアウトは同じボタンを二度押すと元の状態に戻ります。したがって、同じボタンは二度押さなくてよいことがわかります。また、実際にボタンを押してみるとわかりますが、ボタンを押す順番は関係がないことがわかります。たとえば、ボタン 0 と 1 を押す場合、0 -> 1 と押すのも 1 -> 0 と押すのも同じ結果になります。この 2 つの法則から、ボタンを押す組み合わせは全部で 2 ^ 25 通りになります。
ライツアウトを解くいちばん単純な方法は、ボタンを押す組み合わせを生成して、実際にライトが全部消えるかチェックすることです。プログラムは次のようになります。
リスト : ライツアウトの解法
(import (scheme base) (scheme write) (scheme bitwise))
;;; ボタンを押したときのパターン
(define *pattern*
#(#x0000023 #x0000047 #x000008e #x000011c #x0000218
#x0000461 #x00008e2 #x00011c4 #x0002388 #x0004310
#x0008c20 #x0011c40 #x0023880 #x0047100 #x0086200
#x0118400 #x0238800 #x0471000 #x08e2000 #x10c4000
#x0308000 #x0710000 #x0e20000 #x1c40000 #x1880000))
;;; ボタンを押す
(define (push-buttons xs board)
(if (zero? xs)
board
(push-buttons
(bitwise-and xs (- xs 1))
(bitwise-xor (vector-ref *pattern* (first-set-bit xs)) board))))
;;; 解の表示
(define (print-answer xs)
(do ((n 0 (+ n 1)))
((>= n 25))
(display (if (bit-set? n xs) "O " "X "))
(when
(zero? (modulo (+ n 1) 5))
(newline))))
;;; 解法
(define (solver board)
(call/cc
(lambda (ret)
(do ((n 1 (+ n 1)))
((> n 25) #f)
(display "----- ") (display n) (display " -----\n")
(combinations
(lambda (xs)
(when
(zero? (push-buttons xs board))
(print-answer xs)
(ret #t)))
25 n)))))
最初に、ボタンを押したときにライトの状態を反転させるための値をベクタ *pattern* に定義します。そして、関数 solver で盤面 board の解を求めます。関数 combinations で 25 個のボタン (0 - 24) から n 個を選ぶ組み合わせを生成し、関数 push-buttons で選んだボタンを押します。その結果が 0 であれば、関数 print-answer で解を出力し、継続 ret を評価して処理を終了します。
関数 push-buttons は引数 xs の n 番目のビットがオンであれば、n 番目のボタンを押して新しい盤面を生成します。これを再帰定義で行っています。関数 print-answer は押すボタンを O で、押さないボタンを X で表示します。5 行 5 列に出力するため、(modulo (+ n 1) 5) の値が 0 であれば newline で改行を出力します。
それでは実行してみましょう。ライトが全部点灯している状態 (#x1ffffff) を解いてみます。
gosh[r7rs.user]> (let ((s (current-jiffy))) (solver #x1ffffff) (inexact (/ (- (current-jiffy) s) (jiffies-per-second)))) ----- 1 ----- ----- 2 ----- ----- 3 ----- ----- 4 ----- ----- 5 ----- ----- 6 ----- ----- 7 ----- ----- 8 ----- ----- 9 ----- ----- 10 ----- ----- 11 ----- ----- 12 ----- ----- 13 ----- ----- 14 ----- ----- 15 ----- X O O X O X O O O X X X O O O O O X O O O O X X X 42.5287875 実行環境 : Gauche ver 0.9.9, Ubunts 18.04 (WSL), Intel Core i5-6200U 2.30GHz
15 手で解くことができました。実行時間は約 43 秒、とても遅いですね。実は、もっと高速に解く方法があるのです。
下図を見てください。
ＡＢＣＤＥ ＡＢＣＤＥ ＡＢＣＤＥ ＡＢＣＤＥ
１□■□■□ １□□□□□ １□□□□□ １□□□□□
２□□□□□ ２■■□■■ ２□□□□□ ２□□□□□
３□□□□□ ３□■□■□ ３□■□■□ ３□□□□□
４□□□□□ ４□□□□□ ４■■□■■ ４□□□□□
５□□□□□ ５□□□□□ ５□□□□□ ５□■□■□
(1) (2) (3) (4)
図 : 1 行ずつボタンを消灯していく方法
(1) では、1 行目のボタンが 2 つ点灯しています。このボタンを消すには、真下にある 2 行目の B と D のボタンを押せばいいですね。すると (2) の状態になります。次に、2 行目のボタンを消します。3 行目の A, B, D, E のボタンを押して (3) の状態になります。
あとはこれを繰り返して 4 行目までのボタンを消したときに、5 行目のボタンも全部消えていれば成功となります。(4) のように、5 行目のボタンが消えない場合は失敗です。この場合は、1 行目のボタンを押して、点灯パターンを変更します。
2 - 5 行目のボタンの押し方は、1 行目の点灯パターンにより決定されるので、けっきょく 1 行目のボタンの押し方により、解けるか否かが決まります。この場合、ボタンの押し方は、2 ^ 5 = 32 通りしかありせん。つまり、たった 32 通り調べるだけでライツアウトの解を求めることができるのです。
それではプログラムを作りましょう。次のリストをみてください。
リスト : ライツアウトの解法 (高速版)
(define (solver-fast board)
(do ((i 0 (+ i 1)))
((>= i 32))
(let ((xs i) ; 押したボタン (ビット)
(new-board (push-buttons i board))) ; 1 行目を押す (32 通り)
;; 1 行ずつライトを消していく
(do ((j 5 (+ j 1)))
((>= j 25))
(when
(bit-set? (- j 5) new-board)
(set! new-board (bitwise-xor (vector-ref *pattern* j) new-board))
(set! xs (bitwise-ior xs (arithmetic-shift 1 j)))))
(when
(zero? new-board)
(print-answer xs)
(newline)))))
1 行目のボタンの押し方は 32 通りあるので、ボタンの押し方を 0 から 31 までの数値で表すことにします。これらの値は 5 ビットで表すことができるので、ビットがオンであればそのボタンを押すことにします。押したボタンは変数 xs にセットします。最初に、1 行目のボタンを押して新しい盤面を生成し、それを変数 new-board にセットします。
次は、1 行ずつ new-board のライトを消していきます。変数 j が押すするボタンの位置を表します。bit-set? で j - 5 の位置のビットを調べます。それがオンであれば上のライトが点灯しいるので、j 番目のボタンを押します。そして最後に new-board の値をチェックします。new-board が 0 であればライトが全部消えているので、print-answer で解を出力します。
これでプログラムは完成です。それでは実行してみましょう。
gosh[r7rs.user]> (let ((s (current-jiffy))) (solver-fast #x1ffffff) (inexact (/ (- (current-jiffy) s) (jiffies-per-second)))) O O X X X O O X O O X X O O O X O O O X X O O X O O X O O X X O O O X O O O X X O O X O O X X X O O X O O X O X O O O X X X O O O O O X O O O O X X X X X X O O O O X O O O O O X X X O O O X O X O O X 4.421e-4
一瞬で 4 通りの解が出力されました。ボタンを押した回数はどの解も 15 回になります。実は、これがライツアウトの最長手数なのです。ライツアウトの場合、ライトの点灯パターンは 2 ^ 25 = 33554432 通りありますが、実際に解が存在するパターンは、その 1 / 4 の 8388608 通りしかありません。その中で最短回数が 15 回で解けるパターンは 7350 通りあり、そのうちのひとつがライトが全部点灯しているパターンなのです。
ライツアウトの最長手数に興味のある方は、Puzzle DE Programming : ライツアウト の「最長手数を求める」をお読みくださいませ。
このほかに、高橋謙一郎さんの「コンピュータ＆パズル」では、細江万太郎さんが考案されたライツアウトを連立方程式で解く方法が紹介されています。また、拙作のページ「お気楽 Numpy プログラミング超入門」や「Julia Programming: Puzzle DE Julia!!」でも連立方程式によるライツアウトの解法を取り上げています。よろしければお読みくださいませ。
(scheme bitwise) にはビット用の高階関数 bitwise-fold と bitwise-for-each が用意されています。
どちらの関数もビットの値は真偽値 (1: #t, 0: #f) で proc に渡します。ビット数は関数 integer-length が返す値になります。integer-length n は整数 n を表すのに必要最低限のビット数を返します。正整数であれば一番左側のビット 1 までになります。簡単な例を示しましょう。
gosh[r7rs.user]> (bitwise-fold cons '() 127) (#t #t #t #t #t #t #t) gosh[r7rs.user]> (bitwise-fold cons '() 128) (#t #f #f #f #f #f #f #f) gosh[r7rs.user]> (bitwise-fold cons '() 129) (#t #f #f #f #f #f #f #t) gosh[r7rs.user]> (bitwise-for-each (lambda (x) (display x) (newline)) 63) #t #t #t #t #t #t #<undef> gosh[r7rs.user]> (bitwise-for-each (lambda (x) (display x) (newline)) 64) #f #f #f #f #f #f #t #<undef>
ビット 1 だけを順番に取り出す高階関数を作ることもできます。次のリストを見てください。
リスト : ビット用高階関数
(define (bit-for-each proc n)
(when
(positive? n)
(let ((m (bitwise-and n (- n))))
(proc m)
(bit-for-each proc (bitwise-xor n m)))))
(define (bit-for-each-with-index proc n)
(when
(positive? n)
(let ((m (bitwise-and n (- n))))
(proc (bit-count (- m 1)) m)
(bit-for-each-with-index proc (bitwise-xor n m)))))
関数 bit-for-each は高階関数で、ビット 1 を順番に取り出して引数の関数 proc に渡します。整数値 n の最も下位にあるビット 1 は (bitwise-and n (- n)) で求めることができます。この値を変数 m にセットして、関数 proc を呼び出します。それから、(bitwise-xor n m) でビットを反転してオフにします。これでビット 1 を順番に取り出すことができます。bit-for-each-with-index は proc の第 1 引数にビットの位置を渡します。
簡単な実行例を示します。
gosh[r7rs.user]> (bit-for-each (lambda (x) (display x) (newline)) #b10101010) 2 8 32 128 #<undef> gosh[r7rs.user]> (bit-for-each-with-index (lambda (i x) (display (list i x)) (newline)) #b10101010) (1 2) (3 8) (5 32) (7 128) #<undef>
N Queens Problem は「8 クイーン」の拡張バージョンで、N 行 N 列の盤面に N 個のクイーンを互いの利き筋が重ならないように配置する問題です。拙作のページ「パズルの解法 [1]」で作成した「８クイーン」の解法プログラムは、盤面が大きくなると大変遅くなります。今回は高橋謙一郎さんの『Ｎクイーン問題（解の個数を求める）』を参考に、ビット演算を使ってどのくらい高速化するか Gauche で試してみましょう。
プログラムのポイントは、斜めの利き筋のチェックをビット演算で行うことです。次の図を見てください。
0 1 2 3 4
*-------------
| . . . . . .
| . . . -3. . #x02
| . . -2. . . #x04
| . -1. . . . #x08 (1 bit 右シフト)
| Q . . . . . #x10 (Q の位置は 4)
| . +1. . . . #x20 (1 bit 左シフト)
| . . +2. . . #x40
| . . . +3. . #x80
*-------------
図 : 斜めの利き筋のチェック
クイーンの位置をオンビットで表すことします。上図のように 0 列目の 4 番目にクイーンを置いた場合、クイーンの位置は第 4 ビットをオンにした値 #x10 となります。
次に、斜めの利き筋を考えます。上図の場合、1 列目の右斜め上の利き筋は 3 番目 (#x08)、2 列目の右斜め上の利き筋は 2 番目 (#x04) になります。この値は 0 列目のクイーンの位置 #x10 を 1 ビットずつ右シフトすれば求めることができます。また、左斜め上の利き筋の場合、1 列目では 5 番目 (#x20) で 2 列目では 6 番目 (#x40) になるので、今度は 1 ビットずつ左シフトすれば求めることができます。
つまり、右斜め上の利き筋を right、左斜め上の利き筋を left で表すことにすると、right と left にクイーンの位置をセットしたら、隣の列を調べるときに right と left を 1 ビットシフトするだけで、斜めの利き筋を求めることができるわけです。
プログラムは次のようになります。
リスト : N Queens Problem の解法
(import (scheme base) (scheme write) (scheme time)
(scheme bitwise)
(mylib list))
;;; 衝突しているか
(define (conflict? column line board)
(let loop ((x (- column 1)) (ls board))
(cond
((null? ls) #f)
((or (= (- column line) (- x (car ls)))
(= (+ column line) (+ x (car ls))))
#t)
(else
(loop (- x 1) (cdr ls))))))
;;; N Queens の解法 (リスト版)
(define (nqueens n)
(define count 0)
(define (queen ls board)
(if (null? ls)
(set! count (+ count 1))
(for-each
(lambda (n)
(unless
(conflict? (length board) n board)
(queen (remove n ls) (cons n board))))
ls)))
(queen (iota n) '())
count)
;;; ビット用高階関数
(define (bit-for-each proc n)
(when
(positive? n)
(let ((m (bitwise-and n (- n))))
(proc m)
(bit-for-each proc (bitwise-xor n m)))))
;;; ビット版
(define (nqueens-fast n)
(define count 0)
(define (queen qs left right)
(if (zero? qs)
(set! count (+ count 1))
(bit-for-each
(lambda (q)
(unless
(any-bit-set? (bitwise-ior left right) q)
(queen (bitwise-xor qs q)
(arithmetic-shift (bitwise-ior left q) 1)
(arithmetic-shift (bitwise-ior right q) -1))))
qs)))
;;
(queen (- (expt 2 n) 1) 0 0)
count)
;;; 実行
(define (test proc n)
(let ((s (current-jiffy)))
(display (proc n))
(newline)
(inexact (/ (- (current-jiffy) s) (jiffies-per-second)))))
関数 nqueens は「パズルの解法 [1]」と同じようにリストを使ったプログラムです。関数 nqueens-fast はビット版のプログラムです。どちらも解の個数を数えるだけで盤面は出力しません。
ビット版の場合、実際の処理は局所関数 queen で行います。引数 qs はクイーンの位置をビットで表した整数値、right が右斜め上の利き筋、left が左斜め上の利き筋を表します。qs が 0 の場合、全てのクイーンを配置できたので count を +1 します。
そうでなければ、bit-for-each で qs のオンビットを順番に取り出します。ラムダ式の引数 q がクイーンを表します。rigth と left の論理和を計算し、any-bit-set? で同じ位置に q があるかチェックします。そうでなければ、q を盤面に配置することができます。この処理を qs から q を削除して、斜めの利き筋 left と right に q をセットします。このとき、左右に 1 ビットシフトすることをお忘れなく。
実行結果は次のようになりました。
表 : 実行結果 (単位 : 秒)
サイズ : 11 : 12 : 13 | 14
---------+------+-------+-------+--------
解の個数 : 2680 : 14200 : 73712 | 365596
リスト版 : 0.46 : 2.65 : 15.68 | 101.95
ビット版 : 0.17 : 0.87 : 4.80 | 27.96
実行環境 : Gauche ver 0.9.9, Ubunts 18.04 (WSL), Intel Core i5-6200U 2.30GHz
ビット演算を使うことで、約 3 倍の高速化に成功しました。ネイティブコードにコンパイルする言語、たとえば、OCaml や Common Lisp の SBCL などを使うと、ビット演算の効果はもっと高くなるかもしれません。興味のある方は試してみてください。
高橋謙一郎さんが公開された『Ｎクイーン問題（解の個数を求める）』では、ビット演算による高速化やユニーク解の判定方法が詳しく解説されていて、とても勉強になります。興味のある方は、高橋さんのドキュメントをお読みくださいませ。