整数の論理演算とビット操作
Lisp の場合、データ構造を表すのにリストがよく使われます。ところが、問題によってはリストよりもビットで表した方が、プログラムを作るのに都合がよい場合もあります。Common Lisp には、整数の論理演算とビット操作を行う関数が用意されています。
●基本的な論理演算
基本的な論理演算を行う主な関数を下表に示します。
| 関数名 | 機能 |
|---|---|
| logand &rest integers | ビットごとの論理積を返す |
| logior &rest integers | ビットごとの論理和を返す |
| logxor &rest integers | ビットごとの排他的論理和を返す |
| lognot integer | ビットごとの論理的な否定を返す |
logand は引数に対するビットごとの論理積を返します。もし引数が与えられなければ -1 を返します。
* (logand #b0101 #b0011) 1
#b0101
and #b0011
-----------
#b0001
logior は引数に対するビットごとの論理和を返します。もし引数が与えられなければ 0 を返します。
* (logior #b0101 #b0011) 7
#b0101
or #b0011
----------
#b0111
logxor は引数に対するビットごとの排他的論理和を返します。もし引数が与えられなければ 0 を返します。
* (logxor #b0101 #b0011) 6
#b0101
xor #b0011
-----------
#b0110
lognot は引数に対するビットごとの論理的な否定を返します。
* (lognot 0) -1 ; #b1111 .... 1111 * (logand 0 -1) 0 * (lognot 1) -2 ; #b1111 .... 1110 * (logand 1 -2) 0
●基本的なビット操作
基本的なビット操作関数を下表に示します。
| 関数名 | 機能 |
|---|---|
| logtest intger1 integer2 | (not (zerop (logand integer1 integer2))) と同じ |
| logbitp index integer | index 番目のビットが 1 ならば真を返す |
| logcount integer | integer が正ならば 1 のビットの数を、負ならば 0 のビットの数を返す |
| ash integer count | count が正ならば count ビットだけ左シフト、負ならば右シフトする |
logtest は logand の結果が 0 であれば NIL を、そうでなければ T を返します。
* (logtest 3 1) T * (logand 3 1) 1 * (logtest 3 4) NIL * (logand 3 4) 0
logbitp は添字 index の位置にある integer のビットが 1 ならば T を返します。逆に 0 ならば NIL を返します。ビットの位置は配列と同じく 0 から数えます。
* (logbitp 0 #b0101) T * (logbitp 1 #b0101) NIL
logcount は integer が正の値であれば 1 のビットを数えて返します。負の値であれば 0 のビットを数えて返します。
* (logcount 13) 3 ; #b...0001101 * (logcount -13) 2 ; #b...1110011
ash は integer を count ビット左シフトします。下位ビットには 0 が挿入されます。count が負の値であれば count ビット右シフトします。この場合、正の整数では上位ビットに 0 が挿入されます。負の整数では 1 が挿入されます。これを「算術シフト」といいます。
* (ash 1 8) 256 * (ash -1 8) -256 * (ash 256 -8) 1 * (ash -256 -8) -1
●組み合わせの生成
次は n 個の中から r 個を選ぶ組み合わせをビットのオンオフで表してみましょう。たとえば、5 個の数字 (0 - 4) から 3 個を選ぶ場合、数字を 0 bit から 4 bit に対応させます。すると、1, 3, 4 という組み合わせは 11010 と表すことができます。これを Common Lisp でプログラムすると次のようになります。
リスト : 組み合わせの生成
(defun combination (fn n r &optional (a 0))
(cond
((zerop r)
(funcall fn a))
((zerop n) nil)
(t
(combination fn (1- n) r a)
(combination fn (1- n) (1- r) (logior (ash 1 (1- n)) a)))))
関数 combination は N 個の中から R 個を選ぶ組み合わせを生成して出力します。組み合わせはオプショナル引数 A にセットします。R が 0 になったら、組み合わせがひとつできたので関数 FN を呼び出します。N が 0 になったら選ぶ数字がなくなったので NIL を返します。
あとは combination を再帰呼び出しします。最初の呼び出しは N 番目の要素を選ばない場合です。N - 1 個の中から R 個を選びます。次の呼び出しが N 番目の要素を選ぶ場合です。(ash 1 (1- n)) で 1 を N - 1 ビット左シフトして、A との論理和を計算します。これで、N - 1 番目のビットをオンにすることができます。そして、N - 1 個の中から R - 1 個を選びます。
それでは 5 個の中から 3 個を選ぶ combination の実行例を示します。
* (combination (lambda (x) (format t "~5,'0,B~%" x)) 5 3) 00111 01011 01101 01110 10011 10101 10110 11001 11010 11100 NIL
この場合、最小値は 00111 (7) で最大値は 11100 (#x1c) になります。このように、combination は組み合わせを表す数を昇順で出力します。ところで、参考文献 1 の「組み合わせの生成」には、再帰呼び出しを使わずに同じ結果を得る方法が解説されてます。とても巧妙な方法なので、興味のある方は読んでみてください。
1. 奥村晴彦, 『Ｃ言語による最新アルゴリズム事典』, 技術評論社, 1991
●組み合わせに番号を付ける
次は、N 通りある組み合わせに 0 から N - 1 までの番号を付ける方法を紹介しましょう。たとえば、6 個の中から 3 個を選ぶ組み合わせは 20 通りありますが、この組み合わせに 0 から 19 までの番号を付けることができます。1 1 1 0 0 0 を例題に考えてみましょう。次の図を見てください。
図 : 6Ｃ3 の組み合わせ
最初に 5 をチェックします。5 を選ばない場合は 5Ｃ3 = 10 通りありますね。この組み合わせに 0 から 9 までの番号を割り当てることにすると、5 を選ぶ組み合わせの番号は 10 から 19 までとなります。
次に、4 をチェックします。4 を選ばない場合は、4Ｃ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 番目となります。
このように、数字を選ぶときに、数字を選ばない場合の組み合わせの数を足し算していけば、その組み合わせの番号を求めることができるのです。プログラムは次のようになります。
リスト : 組み合わせに番号を付ける
;;; 組み合わせの数
(defun comb (n r)
(if (or (= n r) (zerop r))
1
(/ (* (comb n (1- r)) (1+ (- n r))) r)))
;;; 組み合わせに番号を付ける
(defun comb-to-num (n r c &optional (v 0))
(cond
((or (zerop r) (= n r)) v)
((logbitp (1- n) c)
(comb-to-num (1- n) (1- r) c (+ (comb (1- n) r) v)))
(t
(comb-to-num (1- n) r c v))))
関数 comb-to-num は N 個の中から R 個を選ぶ組み合わせ C を番号に変換します。comb-to-num は C の上位ビットから順番にチェックしていきます。N 個の中から R 個を選ぶ場合、N - 1 番目のビットが 1 であれば n-1Ｃr の値を V に加算して comb-to-num を再帰呼び出しします。このとき、N 個の中から一つ選んだので、R の値を -1 することをお忘れなく。ビットが 0 であれば、V の値はそのままで comb-to-num を再帰呼び出しします。N = R または R = 0 になったら V を返します。これが再帰呼び出しの停止条件になります。
次は、番号から組み合わせを求める関数 num-to-comb を作ります。次のリストを見てください。
リスト : 番号から組み合わせを求める
(defun num-to-comb (n r v &optional (c 0))
(if (= n r)
(logior (1- (expt 2 n)) c)
(let ((k (comb (1- n) r)))
(if (>= v k)
(num-to-comb (1- n) (1- r) (- v k) (logior (ash 1 (1- n)) c))
(num-to-comb (1- n) r v c)))))
関数 num-to-comb は、組み合わせ nＣr の番号 V を組み合わせ C に変換します。num-to-comb は組み合わせ C の上位ビットから決定していきます。たとえば、N = 6, R = 3 の場合、ビットが 1 になるのは 5Ｃ2 = 10 通りあり、0 になるのは 5Ｃ3 = 10 通りあります。したがって、数値が 0 - 9 の場合はビットを 0 にし、10 - 19 の場合はビットを 1 にすればいいわけです。
ビットを 0 にした場合、残りは 5Ｃ3 = 10 通りになるので、同様に次のビットを決定します。ビットを 1 にした場合、残りは 5Ｃ2 = 10 通りになります。数値から 5Ｃ3 = 10 を引いて次のビットを決定します。
プログラムでは、n-1Ｃr の値を関数 comb で求めて変数 K にセットします。V が K 以上であれば C の N - 1 番目のビットを 1 にセットし、V から K を引き算します。そして、次のビットを決めればいいわけです。R = 0 になったら C を返します。また、R が N と等しくなったら、C の残りのビットを全て 1 にセットした値を返します。
それでは実際に試してみましょう。
* (combination (lambda (x) (format t "~6,'0B => ~D~%" x (comb-to-num 6 3 x))) 6 3) 000111 => 0 001011 => 1 001101 => 2 001110 => 3 010011 => 4 010101 => 5 010110 => 6 011001 => 7 011010 => 8 011100 => 9 100011 => 10 100101 => 11 100110 => 12 101001 => 13 101010 => 14 101100 => 15 110001 => 16 110010 => 17 110100 => 18 111000 => 19 NIL * (dotimes (x 20) (format t "~2D => ~6,'0,B~%" x (num-to-comb 6 3 x))) 0 => 000111 1 => 001011 2 => 001101 3 => 001110 4 => 010011 5 => 010101 6 => 010110 7 => 011001 8 => 011010 9 => 011100 10 => 100011 11 => 100101 12 => 100110 13 => 101001 14 => 101010 15 => 101100 16 => 110001 17 => 110010 18 => 110100 19 => 111000 NIL
正常に動作していますね。この方法を使うと、n 個ある組み合わせの中の i 番目 (0 <= i < n) の組み合わせを簡単に求めることができます。
●ちょっと便利なビット操作
最も右側 (LSB 側) にある 1 を 0 にクリアする、逆に最も右側にある 0 を 1 にセットすることは簡単にできます。
(1) 右側にある 1 をクリア => x AND (- x) 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 の個数を数える処理を作ってみましょう。Common Lisp には関数 logcount がありますが、私達でも簡単にプログラムすることができます。次のリストを見てください。
リスト : ビットカウント
(defun bit-count (n &optional (c 0))
(if (zerop n)
c
(bit-count (logand n (1- n)) (1+ c))))
整数 n の右側から順番に 1 をクリアしていき、0 になるまでの回数を求めます。とても簡単ですね。
整数を 32 bit に限定する場合、次の方法で 1 の個数をもっと高速に求めることができます。
リスト : ビットカウント (2)
(defun bit-count32 (n)
(let* ((a (+ (logand n #x55555555) (logand (ash n -1) #x55555555)))
(b (+ (logand a #x33333333) (logand (ash a -2) #x33333333)))
(c (+ (logand b #x0f0f0f0f) (logand (ash b -4) #x0f0f0f0f)))
(d (+ (logand c #x00ff00ff) (logand (ash c -8) #x00ff00ff))))
(+ (logand d #xffff) (ash d -16))))
最初に、整数を 2 bit ずつに分割して 1 の個数を求めます。たとえば、整数 N を 4 bit で考えてみましょう。5 を 2 進数で表すと 0101 になります。N と論理積を計算すると 0, 2 番目のビットが 1 であれば、結果の 0, 2 番目のビットは 1 になります。同様に N を 1 ビット右シフトして論理積を計算すると、1, 3 番目のビットが 1 であれば、結果の 0, 2 番目のビットは 1 になります。あとは、それを足し算すれば 2 bit の中にある 1 の個数を求めることができます。
変数 A には 2 ビットの中の 1 の個数が格納されています。左隣の 2 ビットの値を足し算すれば、4 ビットの中の 1 の個数を求めることができます。次に、左隣の 4 ビットの値を足し算して 8 ビットの中の 1 の個数を求め、左隣の 8 ビットの値を足し算して、というように順番に値を加算していくと 32 ビットの中にある 1 の個数を求めることができます。
bit-count は 1 の個数が多くなると遅くなりますが、bit-count32 は 1 の個数に関係なく高速に動作します。興味のある方は試してみてください。
●パズル「ライツアウト」
それでは簡単な例題として、Puzzel DE Programming で取り上げた ライツアウト というパズルを Common Lisp で解いてみましょう。ライツアウトは光っているボタンをすべて消すことが目的のパズルです。ルールはとても簡単です。あるボタンを押すと、そのボタンと上下左右のボタンの状態が反転します。つまり、光っているボタンは消灯し消えていたボタンは点灯します。次の図を見てください。
図 : ライツアウトの点灯パターン
ボタンは 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 通りになります。
●ライツアウトの解法
ライツアウトを解くいちばん単純な方法は、ボタンを押す組み合わせを生成して、実際にライトが全部消えるかチェックすることです。プログラムは次のようになります。
リスト : ライツアウトの解法
;;; ボタンを押したときのパターン
(defconstant 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))
;;; ボタンを押す
(defun push-buttons (xs board &optional (n 0))
(cond
((zerop xs) board)
((logtest xs 1)
(push-buttons (ash xs -1) (logxor (aref pattern n) board) (1+ n)))
(t
(push-buttons (ash xs -1) board (1+ n)))))
;;; 解の表示
(defun print-answer (xs)
(do ((n 0 (1+ n)))
((>= n 25))
(if (logbitp n xs)
(princ "O ")
(princ "X "))
(when (zerop (mod (1+ n) 5))
(terpri))))
;;; 解法
(defun solver (board)
(dotimes (n 25)
(format t "----- ~d -----~%" (1+ n))
(combination
(lambda (xs)
(when (zerop (push-buttons xs board))
(print-answer xs)
(return-from solver)))
25 (1+ n))))
最初に、ボタンを押したときにライトの状態を反転させるための値をベクタ PATTERN に定義します。そして、関数 solver で盤面 board の解を求めます。combination で 25 個のボタン (0 - 24) から N 個を選ぶ組み合わせを生成し、関数 push-buttons で選んだボタンを押します。その結果が 0 であれば、関数 print-answer で解を出力して、return-from で処理を終了します。
関数 push-buttons は引数 XS の N 番目のビットがオンであれば、N 番目のボタンを押して新しい盤面を生成します。これを再帰定義で行っています。関数 print_answer は押すボタンを O で、押さないボタンを X で表示します。5 行 5 列に出力するため、(mod x 5) の値が 0 であれば terpri で改行を出力します。
それでは実行してみましょう。
* (time (solver #x1ffffff)) ----- 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 Evaluation took: 20.242 seconds of real time 20.250000 seconds of total run time (20.250000 user, 0.000000 system) 100.04% CPU 48,581,473,077 processor cycles 0 bytes consed NIL 実行環境 : Ubunts 18.04 (Windows Subsystem for Linux), Intel Core i5-6200U 2.30GHz
15 手で解くことができましたが、けっこう時間がかかりますね。実は、もっと高速に解く方法があるのです。
●高速化
下図を見てください。
図 : 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 通り調べるだけでライツアウトの解を求めることができるのです。
●解法プログラム
それではプログラムを作りましょう。次のリストをみてください。
リスト : ライツアウトの解法 (高速版)
(defun solver-fast (board)
(dotimes (i 32)
(let ((xs i) ; 押したボタン (ビット)
(new-board (push-buttons i board))) ; 1 行目を押す (32 通り)
;; 1 行ずつライトを消していく
(dotimes (j 20)
(when (logbitp j new-board)
(setq new-board (logxor (aref pattern (+ j 5)) new-board)
xs (logior xs (ash 1 (+ j 5))))))
(when (zerop new-board)
(print-answer xs)
(terpri)))))
1 行目のボタンの押し方は 32 通りあるので、ボタンの押し方を 0 から 31 までの数値で表すことにします。これらの値は 5 ビットで表すことができるので、ビットがオンであればそのボタンを押すことにします。押したボタンは変数 XS にセットします。最初に、1 行目のボタンを押して新しい盤面を生成し、それを変数 NEW-BOARD にセットします。
次は、1 行ずつ NEW-BOARD のライトを消していきます。変数 J がチェックするボタンの位置を表します。logbitp で J の位置のビットを調べます。それがオンであればライトが点灯しいるので、1 行下のボタンを押します。押すボタンの位置は (+ j 5) で求めることができます。そして最後に NEW-BOARD の値をチェックします。NEW-BOARD が 0 であればライトが全部消えているので、print-answer で解を出力します。
●実行結果
これでプログラムは完成です。それでは実行してみましょう。ライトが全部点灯している状態 (#x1ffffff) を解いてみます。
* (solver-fast #x1ffffff) 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 NIL
4 通りの解が出力されました。ボタンを押した回数はどの解も 15 回になります。実は、これがライツアウトの最長手数なのです。ライツアウトの場合、ライトの点灯パターンは 2 ^ 25 = 33554432 通りありますが、実際に解が存在するパターンは、その 1 / 4 の 8388608 通りしかありません。その中で最短回数が 15 回で解けるパターンは 7350 通りあり、そのうちのひとつがライトが全部点灯しているパターンなのです。
ライツアウトの最長手数に興味のある方は、Puzzle DE Programming : ライツアウト の 最長手数を求める をお読みくださいませ。
●ビット配列 (2023/09/10)
Common Lisp の場合、ビットごとの論理演算は整数だけではありません。要素の型がビット (0 or 1) の配列でも行うことができます。これを「ビット配列」といいます。特に、1 次元のビット配列を「ビットベクタ (bit-vector)」といいます。
ビット配列の生成は、関数 make-array の :element-type で (unsigned-byte 1) を指定します。
* (defvar a (make-array '(3 3) :element-type '(unsigned-byte 1))) A * a #2A((0 0 0) (0 0 0) (0 0 0)) * (type-of a) (SIMPLE-ARRAY BIT (3 3)) * (defvar b (make-array 8 :element-type '(unsigned-byte 1))) B * b #*00000000 *(type-of b) (SIMPLE-BIT-VECTOR 8) * (bit-vector-p a) NIL * (bit-vector-p b) T * (typep b 'simple-bit-vector) T * (typep a 'simple-array) T * (typep b 'simple-array) T * (typep a '(simple-array bit)) T * (typep b '(simple-array bit)) T
ビットベクタは #* の後ろのビット列 (0 or 1) で表示されます。'#* + ビット列' でビットベクタを生成することもできます。他の配列により共有されず、フィルポインタを持たず、生成後動的に大きさが変わらない配列のことを「単純配列」といいます。simple-array は単純配列を表す型指定子です。単純なビット配列のデータ型は (simple-array bit) となります。
ビットベクタは型述語 bit-vector-p を使う、または typep と型指定子 bit-vector を使って判定することができます。単純なビットベクタの判定は typep と型指定子 simple-bit-vector を使います。単純なベクタを表す型指定子 simple-vector もありますが、これでビットベクタを判定することはできません。
* (typep b 'simple-vector) NIL * (defvar c (make-array 5)) C * c #(0 0 0 0 0) * (typep c 'simple-vector) T
ビット配列は、普通の配列と同様に関数 aref でアクセスすることができますが、専用の関数 bit, sbit を使ったほうが aref よりも少し速くなるようです。
bit bit-array &rest subscripts sbit simple-bit-array &rest subscripts
bit は引数の型がビット配列 (array bit) であること、sbit は引数の型が単純なビット配列 (simple-array bit) でなければいけません。簡単な例を示しましょう。
* (bit a 0 0) 0 * (sbit a 2 2) 0 * (bit b 0) 0 * (sbit b 7) 0 * (sbit a 1 1) 0 * (setf (sbit a 1 1) 1) 1 * a #2A((0 0 0) (0 1 0) (0 0 0)) * (sbit b 5) 0 * (setf (sbit b 5) 1) 1 * b #*00000100
Common Lisp にはビット配列用の論理演算が用意されています。ここでは基本的な関数を紹介します。
- bit-not ba &optional result
- bit-and ba1 ba2 &optional result
- bit-ior ba1 ba2 &optional result
- bit-xor ba1 ba2 &optional result
bit-not はビット配列の要素ごとの否定、bit-and は論理積、bit-ior は論理和、bit-xor は排他的論理和を求めます。オプション引数 result にビット配列が指定されている場合、結果は配列 result に格納されます。result は破壊的に修正されます。引数は同じランクと次元数を持つビット配列でなければいけません。
簡単な例を示しましょう。
* (bit-not #*0101) #*1010 * (bit-and #*0101 #*0011) #*0001 * (bit-ior #*0101 #*0011) #*0111 * (bit-xor #*0101 #*0011) #*0110
この他にも、便利な関数が用意されています。詳細は CLHS: Function BIT-AND, ... をお読みください。
最後に簡単な例題として、ビットベクタを使って組み合わせを生成する関数 bit-combination を作ります。
リスト : ビットベクタによる組み合わせの生成
(defun make-bit-array (shape)
(make-array shape :element-type '(unsigned-byte 1)))
(defun bit-combination (fn n r &optional (a (make-bit-array n)))
(cond
((zerop r)
(funcall fn a))
((zerop n) nil)
(t
(bit-combination fn (1- n) r a)
(setf (sbit a (1- n)) 1)
(bit-combination fn (1- n) (1- r) a)
(setf (sbit a (1- n)) 0))))
関数 make-bit-array は形状 shape のビット配列を生成します。bit-combination は関数 combination をビットベクタに変更しただけです。ビットベクタ a を破壊的に修正していることに注意してください。それでは実際に試してみましょう。
* (make-bit-array 5) #*00000 * (make-bit-array '(3 3)) #2A((0 0 0) (0 0 0) (0 0 0)) * (bit-combination #'print 5 3) #*11100 #*11010 #*10110 #*01110 #*11001 #*10101 #*01101 #*10011 #*01011 #*00111 0 * (bit-combination #'print 6 4) #*111100 #*111010 #*110110 #*101110 #*011110 #*111001 #*110101 #*101101 #*011101 #*110011 #*101011 #*011011 #*100111 #*010111 #*001111 0
正常に動作していますね。
●参考 URL
ビットが 1 の個数を数える方法は フィンローダさん の 初級Ｃ言語Ｑ＆Ａ(15) を参考にさせていただきました。フィンローダさんに感謝いたします。
このほかに、高橋謙一郎さんの コンピュータ＆パズル では、細江万太郎さんが考案されたライツアウトを連立方程式で解く方法が紹介されています。また、拙作のページ お気楽 Numpy プログラミング超入門 や Julia Programming: Puzzle DE Julia!! でも連立方程式によるライツアウトの解法を取り上げています。よろしければお読みくださいませ。
●プログラムリスト
;;;
;;; lo.lisp : ライツアウトの解法
;;;
;;; Copyright (C) 2020 Makoto Hiroi
;;;
;;; 組み合わせの生成
(defun combination (fn n r &optional (a 0))
(cond
((zerop r)
(funcall fn a))
((zerop n) nil)
(t
(combination fn (1- n) r a)
(combination fn (1- n) (1- r) (logior (ash 1 (1- n)) a)))))
;;; ボタンを押したときのパターン
(defconstant 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))
;;; ボタンを押す
(defun push-buttons (xs board &optional (n 0))
(cond
((zerop xs) board)
((logtest xs 1)
(push-buttons (ash xs -1) (logxor (aref pattern n) board) (1+ n)))
(t
(push-buttons (ash xs -1) board (1+ n)))))
;;; 速度の違いはあまりなかった
(defun push-buttons-fast (xs board)
(if (zerop xs)
board
(let ((x (logand xs (- xs))))
(push-buttons-fast (logxor xs x)
(logxor (aref pattern (logcount (1- x))) board)))))
;;; 解の表示
(defun print-answer (xs)
(do ((n 0 (1+ n)))
((>= n 25))
(if (logbitp n xs)
(princ "O ")
(princ "X "))
(when (zerop (mod (1+ n) 5))
(terpri))))
;;; 解法
(defun solver (board)
(dotimes (n 25)
(format t "----- ~d -----~%" (1+ n))
(combination
(lambda (xs)
(when (zerop (push-buttons xs board))
(print-answer xs)
(return-from solver)))
25 (1+ n))))
;;; 高速版
(defun solver-fast (board)
(dotimes (i 32)
(let ((xs i) ; 押したボタン (ビット)
(new-board (push-buttons i board))) ; 1 行目を押す (32 通り)
;; 1 行ずつライトを消していく
(dotimes (j 20)
(when (logbitp j new-board)
(setq new-board (logxor (aref pattern (+ j 5)) new-board)
xs (logior xs (ash 1 (+ j 5))))))
(when (zerop new-board)
(print-answer xs)
(terpri)))))