Lisp 言語の場合、データ構造を表すのにリストがよく使われます。ところが、問題によってはリストよりもビットで表した方が、プログラムを作るのに都合がよい場合もあります。Clojure には、整数の論理演算とビット操作を行う関数が用意されています。
基本的な論理演算を行う主な関数を下表に示します。
| 関数名 | 機能 |
|---|---|
| bit-and x y ... | ビットごとの論理積を返す |
| bit-or x y ... | ビットごとの論理和を返す |
| bit-xor x y ... | ビットごとの排他的論理和を返す |
| bit-not x | ビットごとの論理的な否定を返す |
bit-and は引数に対するビットごとの論理積を返します。
user=> (bit-and 2r0101 2r0011) 1
2r0101
and 2r0011
-----------
2r0001
bit-or は引数に対するビットごとの論理和を返します。
user=> (bit-or 2r0101 2r0011) 7
2r0101
or 2r0011
----------
2r0111
bit-xor は引数に対するビットごとの排他的論理和を返します。
user=> (bit-xor 2r0101 2r0011) 6
2r0101
xor 2r0011
-----------
2r0110
bit-not は引数に対するビットごとの論理的な否定を返します。
user=> (bit-not 0) -1 ; 2r1111 .... 1111 user=> (bit-and 0 -1) 0 user=> (bit-not 1) -2 ; 2r1111 .... 1110 user=> (bit-and 1 -2) 0
基本的なビット操作関数を下表に示します。
| 関数名 | 機能 |
|---|---|
| bit-test integer index | index 番目のビットが 1 ならば真を返す |
| bit-set integer index | index 番目のビットを 1 にする |
| bit-clear integer index | index 番目のビットを 0 にする |
| bit-flip integer index | index 番目のビットを反転する |
| bit-shift-left integer count | count ビットだけ左シフトする |
| bit-shift-right integer count | count ビットだけ右シフトする |
bit-test は添字 index の位置にある integer のビットが 1 ならば true を返します。逆に 0 ならば false を返します。ビットの位置は配列と同じく 0 から数えます。
user=> (bit-test 2r0101 2) true user=> (bit-test 2r0101 1) false
bit-set は index 番目のビットを 1 に、bit-clear は index 番目のビットを 0 に、bit-filp は index 番目のビットを反転します。
user=> (bit-set 2r0101 1) 7 ; 2r0111 user=> (bit-clear 2r0101 2) 1 ; 2r0001 user=> (bit-flip 2r0101 3) 13 ; 2r1101 user=> (bit-flip 2r0101 0) 4 ; 2r0100
bit-shift-left は integer を count ビット左シフトします。下位ビットには 0 が挿入されます。bit-shift-right は count ビット右シフトします。この場合、正の整数では上位ビットに 0 が挿入されます。負の整数では 1 が挿入されます。これを「算術シフト」といいます。
user=> (bit-shift-left 1 8) 256 user=> (bit-shift-left -1 8) -256 user=> (bit-shift-right 256 8) 1 user=> (bit-shift-right -256 8) -1
次は n 個の中から r 個を選ぶ組み合わせをビットのオンオフで表してみましょう。たとえば、5 個の数字 (0 - 4) から 3 個を選ぶ場合、数字を 0 bit から 4 bit に対応させます。すると、1, 3, 4 という組み合わせは 11010 と表すことができます。これを Clojure でプログラムすると次のようになります。
リスト : 組み合わせの生成
(defn combination
([func n r] (combination func n r 0))
([func n r a]
(cond
(zero? r) (func a)
(zero? n) nil
:else (do
(combination func (dec n) r a)
(combination func (dec n) (dec r) (bit-set a (dec n)))))))
関数 combination は n 個の中から r 個を選ぶ組み合わせを生成して出力します。組み合わせは引数 a にセットします。r が 0 になったら、組み合わせがひとつできたので関数 func を呼び出します。n が 0 になったら選ぶ数字がなくなったので nil を返します。
あとは combination を再帰呼び出しします。最初の呼び出しは n 番目の要素を選ばない場合です。n - 1 個の中から r 個を選びます。次の呼び出しが n 番目の要素を選ぶ場合です。bit-set で n - 1 番目のビットをオンにします。そして、n - 1 個の中から R - 1 個を選びます。
それでは 5 個の中から 3 個を選ぶ combination の実行例を示します。
user=> (combination (fn [n] (printf "%2x\n" n)) 5 3) 7 b d e 13 15 16 19 1a 1c nil
この場合、最小値は 00111 (7) で最大値は 11100 (0x1c) になります。このように、combination は組み合わせを表す数を昇順で出力します。ところで、参考文献 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Ｃ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 番目となります。
このように、数字を選ぶときに、数字を選ばない場合の組み合わせの数を足し算していけば、その組み合わせの番号を求めることができるのです。プログラムは次のようになります。
リスト : 組み合わせに番号を付ける
;; 組み合わせの数
(defn comb [n r]
(if (or (== n r) (zero? r))
1
(/ (* (comb n (dec r)) (inc (- n r))) r)))
;; 組み合わせに番号を付ける
(defn comb-to-num
([n r c] (comb-to-num n r c 0))
([n r c v]
(cond
(or (zero? r) (== n r)) v
(bit-test c (dec n))
(comb-to-num (dec n) (dec r) c (+ (comb (dec n) r) v))
:else (comb-to-num (dec 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 を作ります。次のリストを見てください。
リスト : 番号から組み合わせを求める
(defn num-to-comb
([n r v] (num-to-comb n r v 0))
([n r v c]
(if (= n r)
(bit-or (dec (bit-shift-left 1 n)) c)
(let [k (comb (dec n) r)]
(if (>= v k)
(num-to-comb (dec n) (dec r) (- v k) (bit-set c (dec n)))
(num-to-comb (dec 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 にセットした値を返します。
それでは実際に試してみましょう。
user=> (combination (fn [x] (printf "%2x => %2d\n" x (comb-to-num 6 3 x))) 6 3) 7 => 0 b => 1 d => 2 e => 3 13 => 4 15 => 5 16 => 6 19 => 7 1a => 8 1c => 9 23 => 10 25 => 11 26 => 12 29 => 13 2a => 14 2c => 15 31 => 16 32 => 17 34 => 18 38 => 19 nil user=> (dotimes [x 20] (printf "%2d => %2x\n" x (num-to-comb 6 3 x))) 0 => 7 1 => b 2 => d 3 => e 4 => 13 5 => 15 6 => 16 7 => 19 8 => 1a 9 => 1c 10 => 23 11 => 25 12 => 26 13 => 29 14 => 2a 15 => 2c 16 => 31 17 => 32 18 => 34 19 => 38 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 の個数を数える処理を作ってみましょう。次のリストを見てください。
リスト : ビットカウント
(defn bit-count
([n] (bit-count n 0))
([n c]
(if (zero? n)
c
(recur (bit-and n (dec n)) (inc c)))))
整数 n の右側から順番に 1 をクリアしていき、0 になるまでの回数を求めます。とても簡単ですね。
整数を 32 bit に限定する場合、次の方法で 1 の個数をもっと高速に求めることができます。
リスト : ビットカウント (2)
(defn bit-count32 [n]
(let [a (+ (bit-and n 0x55555555)
(bit-and (bit-shift-right n 1) 0x55555555))
b (+ (bit-and a 0x33333333)
(bit-and (bit-shift-right a 2) 0x33333333))
c (+ (bit-and b 0x0f0f0f0f)
(bit-and (bit-shift-right b 4) 0x0f0f0f0f))
d (+ (bit-and c 0x00ff00ff)
(bit-and (bit-shift-right c 8) 0x00ff00ff))]
(+ (bit-and d 0xffff) (bit-shift-right 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 で取り上げた「ライツアウト」というパズルを Clojure で解いてみましょう。ライツアウトは光っているボタンをすべて消すことが目的のパズルです。ルールはとても簡単です。あるボタンを押すと、そのボタンと上下左右のボタンの状態が反転します。つまり、光っているボタンは消灯し消えていたボタンは点灯します。次の図を見てください。
□□□□□ □□□□□ ０ １ ２ ３ ４
□□□□□ □□■□□ ５ ６ ７ ８ ９
□□□□□ ─→ □■■■□ 10 11 12 13 14
□□□□□ □□■□□ 15 16 17 18 19
□□□□□ □□□□□ 20 21 22 23 24
（Ａ）中央のボタンを押した場合 （Ｂ）座標
図 : ライツアウトの点灯パターン
ボタンは 5 行 5 列に配置されています。上図に示したように、中央のボタン 12 を押すとそのボタンと上下左右のボタンの状態が反転します。
ライツアウトはライトオン・オフの 2 種類の状態しかないので、盤面はリストよりもビットを使って表した方が簡単です。ライトオン・オフの状態を 1 と 0 で表し、各ビットとボタンの座標を対応させると、盤面は 0 から 33554431 の整数値で表すことができます。
ボタンを押してライトの状態を反転する処理も簡単です。たとえば、中央のボタン 12 を押した場合、7, 11, 12, 13, 17 のライトを反転させます。この場合、5 つのボタンのビットをオンにした値 0x23880 と、盤面を表す整数値の排他的論理和 (xor) を求めれば、5 つのライトの状態を反転することができます。次の例を見てください。
0 xor 0x23880 => 0x23880 % 消灯の状態でボタン 12 を押す (点灯する) 0x23880 xor 0x23880 => 0 % もう一度同じボタンを押す (消灯する)
このように、ライツアウトは同じボタンを二度押すと元の状態に戻ります。したがって、同じボタンは二度押さなくてよいことがわかります。また、実際にボタンを押してみるとわかりますが、ボタンを押す順番は関係がないことがわかります。たとえば、ボタン 0 と 1 を押す場合、0 -> 1 と押すのも 1 -> 0 と押すのも同じ結果になります。この 2 つの法則から、ボタンを押す組み合わせは全部で 2 ^ 25 通りになります。
ライツアウトを解くいちばん単純な方法は、ボタンを押す組み合わせを生成して、実際にライトが全部消えるかチェックすることです。プログラムは次のようになります。
リスト : ライツアウトの解法
;; ボタンを押したときのパターン
(def pattern
[0x0000023 0x0000047 0x000008e 0x000011c 0x0000218
0x0000461 0x00008e2 0x00011c4 0x0002388 0x0004310
0x0008c20 0x0011c40 0x0023880 0x0047100 0x0086200
0x0118400 0x0238800 0x0471000 0x08e2000 0x10c4000
0x0308000 0x0710000 0x0e20000 0x1c40000 0x1880000])
;; ボタンを押す
(defn push-buttons [xs board]
(let [a (atom board)]
(dotimes [n 25]
(when (bit-test xs n)
(swap! a bit-xor (get pattern n))))
@a))
;; 解の表示
(defn print-answer [xs]
(dotimes [n 25]
(printf (if (bit-test xs n) "O " "X "))
(when (zero? (mod (inc n) 5))
(newline))))
;; 解法
(defn solver [board]
(dotimes [n 25]
(printf "----- %d -----\n" (inc n))
(combination
(fn [xs]
(when (zero? (push-buttons xs board))
(print-answer xs)
(newline)))
25 (inc n))))
最初に、ボタンを押したときにライトの状態を反転させるための値をベクタ pattern に定義します。そして、関数 solver で盤面 board の解を求めます。combination で 25 個のボタン (0 - 24) から n 個を選ぶ組み合わせを生成し、関数 push-buttons で選んだボタンを押します。その結果が 0 であれば、関数 print-answer で解を出力します。
関数 push-buttons は引数 xs の n 番目のビットがオンであれば、n 番目のボタンを押して新しい盤面を生成します。これを繰り返し (dotimes) で処理するため、board は atom で包んで値を書き換えられるようにしています。関数 print-answer は押すボタンを O で、押さないボタンを X で表示します。5 行 5 列に出力するため、(mod x 5) の値が 0 であれば newline で改行を出力します。
それでは実行してみましょう。
user=> (time (solver 0x1ffffff)) ----- 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 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 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 ----- 16 ----- ----- 17 ----- ----- 18 ----- ----- 19 ----- ----- 20 ----- ----- 21 ----- ----- 22 ----- ----- 23 ----- ----- 24 ----- ----- 25 ----- "Elapsed time: 26983.247287 msecs" nil 実行環境 : Ubunts 22.04 (WSL2), 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 通り調べるだけでライツアウトの解を求めることができるのです。
それではプログラムを作りましょう。次のリストをみてください。
リスト : ライツアウトの解法 (高速版)
(defn solver-fast [board]
(dotimes [i 32]
(let [xs (atom i) ; 押したボタン (ビット)
new-board (atom (push-buttons i board))] ; 1 行目を押す (32 通り)
;; 1 行ずつライトを消していく
(dotimes [j 20]
(when (bit-test @new-board j)
(swap! new-board bit-xor (get pattern (+ j 5)))
(swap! xs bit-or (bit-shift-left 1 (+ j 5)))))
(when (zero? @new-board)
(print-answer @xs)
(newline)))))
1 行目のボタンの押し方は 32 通りあるので、ボタンの押し方を 0 から 31 までの数値で表すことにします。これらの値は 5 ビットで表すことができるので、ビットがオンであればそのボタンを押すことにします。押したボタンは変数 xs にセットします。最初に、1 行目のボタンを押して新しい盤面を生成し、それを変数 new-board にセットします。どちらの変数も値を書き換えるため、atom で包んでいることに注意してください。
次は、1 行ずつ new-board のライトを消していきます。変数 j がチェックするボタンの位置を表します。bit-test で j の位置のビットを調べます。それがオンであればライトが点灯しいるので、1 行下のボタンを押します。押すボタンの位置は (+ j 5) で求めることができます。そして最後に new-board の値をチェックします。@new-board が 0 であればライトが全部消えているので、print-answer で解を出力します。
これでプログラムは完成です。それでは実行してみましょう。ライトが全部点灯している状態 0x1ffffff) を解いてみます。
user=> (time (solver-fast 0x1ffffff)) 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 "Elapsed time: 2.480395 msecs" nil
4 通りの解が出力されました。ボタンを押した回数はどの解も 15 回になります。実は、これがライツアウトの最長手数なのです。ライツアウトの場合、ライトの点灯パターンは 2 ^ 25 = 33554432 通りありますが、実際に解が存在するパターンは、その 1 / 4 の 8388608 通りしかありません。その中で最短回数が 15 回で解けるパターンは 7350 通りあり、そのうちのひとつがライトが全部点灯しているパターンなのです。
ライツアウトの最長手数に興味のある方は、Puzzle DE Programming: 「ライツアウト」の「最長手数を求める」をお読みくださいませ。
ビットが 1 の個数を数える方法はフィンローダさんの「初級Ｃ言語Ｑ＆Ａ(15)」を参考にさせていただきました。フィンローダさんに感謝いたします。
このほかに、高橋謙一郎さんの「コンピュータ＆パズル」では、細江万太郎さんが考案されたライツアウトを連立方程式で解く方法が紹介されています。また、拙作のページ「お気楽 Numpy プログラミング超入門」や「Julia Programming: Puzzle DE Julia!!」でも連立方程式によるライツアウトの解法を取り上げています。よろしければお読みくださいませ。
;;;
;;; sample_bit.clj : ビット演算のサンプルプログラム
;;;
;;; Copyright (C) 2025 Makoto Hiroi
;;;
;; 組み合わせの生成
(defn combination
([func n r] (combination func n r 0))
([func n r a]
(cond
(zero? r) (func a)
(zero? n) nil
:else (do
(combination func (dec n) r a)
(combination func (dec n) (dec r) (bit-set a (dec n)))))))
;; 組み合わせの数
(defn comb [n r]
(if (or (== n r) (zero? r))
1
(/ (* (comb n (dec r)) (inc (- n r))) r)))
;; 組み合わせに番号を付ける
(defn comb-to-num
([n r c] (comb-to-num n r c 0))
([n r c v]
(cond
(or (zero? r) (== n r)) v
(bit-test c (dec n))
(comb-to-num (dec n) (dec r) c (+ (comb (dec n) r) v))
:else (comb-to-num (dec n) r c v))))
;; 番号から組み合わせを求める
(defn num-to-comb
([n r v] (num-to-comb n r v 0))
([n r v c]
(if (= n r)
(bit-or (dec (bit-shift-left 1 n)) c)
(let [k (comb (dec n) r)]
(if (>= v k)
(num-to-comb (dec n) (dec r) (- v k) (bit-set c (dec n)))
(num-to-comb (dec n) r v c))))))
;; ビットカウント
(defn bit-count
([n] (bit-count n 0))
([n c]
(if (zero? n)
c
(recur (bit-and n (dec n)) (inc c)))))
(defn bit-count32 [n]
(let [a (+ (bit-and n 0x55555555)
(bit-and (bit-shift-right n 1) 0x55555555))
b (+ (bit-and a 0x33333333)
(bit-and (bit-shift-right a 2) 0x33333333))
c (+ (bit-and b 0x0f0f0f0f)
(bit-and (bit-shift-right b 4) 0x0f0f0f0f))
d (+ (bit-and c 0x00ff00ff)
(bit-and (bit-shift-right c 8) 0x00ff00ff))]
(+ (bit-and d 0xffff) (bit-shift-right d 16))))
;;
;; ライツアウトの解法
;;
;; ボタンを押したときのパターン
(def pattern
[0x0000023 0x0000047 0x000008e 0x000011c 0x0000218
0x0000461 0x00008e2 0x00011c4 0x0002388 0x0004310
0x0008c20 0x0011c40 0x0023880 0x0047100 0x0086200
0x0118400 0x0238800 0x0471000 0x08e2000 0x10c4000
0x0308000 0x0710000 0x0e20000 0x1c40000 0x1880000])
;; ボタンを押す
(defn push-buttons [xs board]
(let [a (atom board)]
(dotimes [n 25]
(when (bit-test xs n)
(swap! a bit-xor (get pattern n))))
@a))
;; 解の表示
(defn print-answer [xs]
(dotimes [n 25]
(printf (if (bit-test xs n) "O " "X "))
(when (zero? (mod (inc n) 5))
(newline))))
;; 解法
(defn solver [board]
(dotimes [n 25]
(printf "----- %d -----\n" (inc n))
(combination
(fn [xs]
(when (zero? (push-buttons xs board))
(print-answer xs)
(newline)))
25 (inc n))))
;; 高速版
(defn solver-fast [board]
(dotimes [i 32]
(let [xs (atom i) ; 押したボタン (ビット)
new-board (atom (push-buttons i board))] ; 1 行目を押す (32 通り)
;; 1 行ずつライトを消していく
(dotimes [j 20]
(when (bit-test @new-board j)
(swap! new-board bit-xor (get pattern (+ j 5)))
(swap! xs bit-or (bit-shift-left 1 (+ j 5)))))
(when (zero? @new-board)
(print-answer @xs)
(newline)))))