Lisp の場合、データ構造を表すのにリストがよく使われます。ところが、問題によってはリストよりもビットで表した方が、プログラムを作るのに都合がよい場合もあります。Common Lisp には、整数の論理演算とビット操作を行う関数が用意されています。論理演算とビット操作を行う主な関数を表 1 に示します。
関数名 | 機能 |
---|---|
logand &rest integers | ビットごとの論理積を返す |
logior &rest integers | ビットごとの論理和を返す |
logxor &rest integers | ビットごとの排他的論理和を返す |
lognot integer | ビットごとの論理的な否定を返す |
logbitp index integer | index 番目のビットが 1 ならば真を返す |
logcount integer | integer が正ならば 1 のビットの数を、負ならば 0 のビットの数を返す |
ash integer count | count が正ならば count ビットだけ左シフト、負ならば右シフトする |
logand は引数に対するビットごとの論理積を返します。もし引数が与えられなければ -1 を返します。
(logand #b0101 #b0011) => 1 (#b0001)
#b0101 and #b0011 ----------- #b0001
logior は引数に対するビットごとの論理和を返します。もし引数が与えられなければ 0 を返します。
(logior #b0101 #b0011) => 7 (#b0111)
#b0101 or #b0011 ---------- #b0111
logxor は引数に対するビットごとの排他的論理和を返します。もし引数が与えられなければ 0 を返します。
(logxor #b0101 #b0011) => 6 (#b0110)
#b0101 xor #b0011 ----------- #b0110
lognot は引数に対するビットごとの論理的な否定を返します。
(lognot 0) => -1 (#b1111 .... 1111) (logand 0 -1) => 0 (lognot 1) => -2 (#b1111 .... 1110) (logand 1 -2) => 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 ビット左シフトします。count が負の値であれば count ビット右シフトします。
(ash 1 3) => 8 ; #b0001 => #b1000 (ash 8 -2) => 2 ; #b1000 => #b0010
それでは、例題として Puzzel DE Programming で取り上げた「ライツアウト」というパズルを Lisp で解いてみましょう。ライツアウトの説明は Puzzle DE Programming と重複するところがありますが、ご了承くださいませ。
ライツアウトは光っているボタンをすべて消すことが目的のパズルです。ルールはとても簡単です。あるボタンを押すと、そのボタンと上下左右のボタンの状態が反転します。つまり、光っているボタンは消灯し消えていたボタンは点灯します。次の図を見てください。
□□□□□ □□□□□ 0 1 2 3 4 □□□□□ □□■□□ 5 6 7 8 9 □□□□□ ─→ □■■■□ 10 11 12 13 14 □□□□□ □□■□□ 15 16 17 18 19 □□□□□ □□□□□ 20 21 22 23 24 (A)中央のボタンを押した場合 (B)座標 図 1 : ライツアウトの点灯パターン
ボタンは 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 通りになります。ライツアウトを解くいちばん単純な方法は、ボタンを押す組み合わせを生成して、実際にライトが全部消えるかチェックすることです。ところが、この方法ではちょっと時間がかかるのです。高速 CPU を搭載した最新マシンを使えば、xyzzy Lisp でも短時間で解けると思いますが、M.Hiroi のオンボロマシン (Pentium 166 MHz) ではけっこう時間がかかるでしょう。実は、もっと高速に解く方法があるのです。
ABCDE ABCDE ABCDE ABCDE 1□■□■□ 1□□□□□ 1□□□□□ 1□□□□□ 2□□□□□ 2■■□■■ 2□□□□□ 2□□□□□ 3□□□□□ 3□■□■□ 3□■□■□ 3□□□□□ 4□□□□□ 4□□□□□ 4■■□■■ 4□□□□□ 5□□□□□ 5□□□□□ 5□□□□□ 5□■□■□ (1) (2) (3) (4) 図 2 : 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 通り調べるだけでライツアウトの解を求めることができるのです。
このほかに、高橋謙一郎さんの「コンピュータ&パズル」では、細江万太郎さんが考案されたライツアウトを連立方程式で解く方法が紹介されています。この方法には M.Hiroi も驚きました。
それではプログラムを作りましょう。次のリストをみてください。
List 1 : ライツアウトの解法 ; ボタンを押したときのパターン (defvar *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 solve (board) (dotimes (i 32) (let ((new-board board) pushed-button) ; 1 行目のボタンを押す (dotimes (j 5) (when (logbitp j i) (push j pushed-button) (setq new-board (logxor new-board (aref *pattern* j))))) ; 1 行ずつライトを消していく (dotimes (j 20) (when (logbitp j new-board) (push (+ j 5) pushed-button) (setq new-board (logxor new-board (aref *pattern* (+ j 5)))))) ; ライトが全部消えたか (if (zerop new-board) (print-answer (reverse pushed-button))))))
最初に、ボタンを押したときにライトの状態を反転させるための値をベクタ *pattern* に定義します。そして、関数 solve で盤面 board の解を求めます。
1 行目のボタンの押し方は 32 通りあるので、ボタンの押し方を 0 から 31 までの数値で表すことにします。これらの値は 5 ビットで表すことができるので、ビットとボタンの位置を対応させて、ビットがオンであればそのボタンを押すことにします。盤面 board を new-board にセットして、logxor で new-board の点灯パターンを変更します。押したボタンの番号は変数 pushed-button のリストに格納します。
次は、1 行ずつ new-board のライトを消していきます。変数 j がチェックするボタンの位置を表します。logbitp で j の位置のビットを調べ、それがオンであればライトが点灯しいるので 1 行下のボタンを押します。押すボタンの位置は (+ j 5) で求めることができます。そして最後に new-board の値をチェックします。new-board が 0 であればライトが全部消えているので、print-answer で解を出力します。このとき、pushed-button を reverse で逆順にしてから print-answer に渡します。
最後に、解を出力する print-answer を作ります。
List 2 : 解の出力 (defun print-answer (pushed-button) (dotimes (x 25 (terpri)) (if (zerop (mod x 5)) (terpri)) (cond ((and pushed-button (= x (car pushed-button))) (princ "○") (pop pushed-button)) (t (princ "×")))))
print_answer は押すボタンを○で、押さないボタンを×で表示します。5 行 5 列に出力するため、(mod x 5) の値が 0 であれば terpri で改行を出力します。引数 pushed-button には、ボタンの番号が昇順に格納されています。変数 x と pushed-button の先頭要素が等しい場合は、○を出力して先頭の要素を pop で取り除きます。等しくない場合や pushed-pattern が空リストの場合は×を出力します。
これでプログラムは完成です。それでは実行してみましょう。ライトが全部点灯している状態 (#x1ffffff) を解いてみます。
(solve #x1ffffff) ○○××× ○○×○○ ××○○○ ×○○○× ×○○×○ ○×○○× ×○○○× ○○○×× ○○×○○ ×××○○ ×○○×○ ×○○○× ××○○○ ○○×○○ ○○××× ×××○○ ○○×○○ ○○○×× ×○○○× ○×○○× nil
4 通りの解が出力されました。ボタンを押した回数はどの解も 15 回になります。実は、これがライツアウトの最長手数なのです。ライツアウトの場合、ライトの点灯パターンは 2 ^ 25 = 33554432 通りありますが、実際に解が存在するパターンは、その 1 / 4 の 8388608 通りしかありません。その中で最短回数が 15 回で解けるパターンは 7350 通りあり、そのうちのひとつがライトが全部点灯しているパターンなのです。
ライツアウトの最長手数に興味のある方は、Puzzle DE Programming 「ライツアウト : 最長手数を求める」をお読みくださいませ。
ニム (nim) は「三山くずし」とも呼ばれている「石取りゲーム」です。ルールはとても簡単です。石の山を 3 つ作り、交互にどれかひとつの山から 1 個以上の石を取っていきます。複数の山から石を取ることはできません。そして、最後に石を取った方が勝ちとなります。今回はニムをプレイするプログラムを作ってみましょう。ニムはとても簡単な方法で、とても強いプログラムを作ることができます。
各山の石の数を N1, N2, N3 として、ビットごとの排他的論理和 N1 xor N2 xor N3 を計算します。これをニム和といいます。そして、ニム和を 0 にすることができれば、勝つことができるのです。ここで、石を全部取った状態は、ニム和が 0 になることに注目してください。
ニム和が 0 の状態では、どのような石の取り方をしてもニム和は 0 になりません。したがって、自分の手番でニム和を 0 にすることができれば、最後の石を相手に取られることはないのです。つまり、最後の石を取るのは自分というわけです。もしもニム和を 0 にできなければ、最大の山から石をひとつだけとって相手のミスを待ちます。
それではプログラムを作りましょう。ポイントは、ニム和を 0 にする指し手を求める処理です。次の例を見てください。
三山:(1 2 4) ニム和: #b001 xor #b010 xor #b100 = #b111 ( 7 ) 指し手の決定 #b001 ( 1 ) xor #b111 = #b110 ( 6 ) 1 - 6 = -5 NG #b010 ( 2 ) xor #b111 = #b101 ( 5 ) 2 - 5 = -3 NG #b100 ( 4 ) xor #b111 = #b011 ( 3 ) 4 - 3 = 1 OK 最後の山から石をひとつ取る ニム和:#b001 xor #b010 xor #b011 = 0
今回は三山をリストで表します。今、石は 1, 2, 4 個あるとします。この場合、ニム和は #b111 ( 7 ) になります。ニム和を 0 にするには、同じ数値 #b111 と排他的論理和をとります。つまり、#b001 xor #b010 xor #b100 xor #b111 とすればいいわけです。ここで、論理演算は交換法則と結合法則が成立するので、#b111 の位置を入れ替えて、各山の石数と #b111 の排他的論理和を先に計算してみましょう。
最初の山は #b001 xor #b111 = #b110 になります。ここで、最初の山の石数 #b001 を #b110 にすることができれば、ニム和が 0 になることに注意してください。この場合は石を 1 個から 6 個へと 5 個増やすことになり、残念ながら実現できません。次の山も #b010 xor #b111 = #b101 になり、石を 3 個増やさないといけません。最後の山は #b100 xor #b111 = #b011 ですから、石を 4 個から 3 個へ 1 個減らせばニム和を 0 にすることができますね。したがって、指し手は「最後の山から石を 1 個取る」となります。
このように、簡単な方法でコンピュータの指し手を求めることができます。プログラムは次のようになります。
List 3 : コンピュータの指し手 ; 石がいちばん多い山を求める (defun max-position (nim) (let ((num -1) pos) (dotimes (x 3 (values pos 1)) (if (< num (nth x nim)) (setq pos x num (nth x nim)))))) ; ニム和が 0 になる指し手を求める (defun safe-position (nim) (let ((nim-sum (apply #'logxor nim)) num) (dotimes (x 3) (setq num (- (nth x nim) (logxor (nth x nim) nim-sum))) (if (plusp num) (return (values x num)))))) ; コンピュータの指し手 (defun move-com (nim) (format t "~%~S 私の手番です~%" nim) (multiple-value-bind (pos num) (if (zerop (apply #'logxor nim)) (max-position nim) (safe-position nim)) (remove-stone nim pos num)))
コンピュータの指し手は関数 move-com で求めます。引数 nim が三山を表すリストです。(apply #'logxor nim) でニム和を求め、その値が 0 ならば関数 max-position で石の数がいちばん多い山の位置を求めます。そうでなければ、関数 safe-position でニム和を 0 にする指し手を求めます。2 つの関数は山の位置と取り除く石の数を返すので、multiple-value-bind で 2 つの値を受け取って関数 remove-stone で石を取り除きます。
max-position は簡単です。dotimes で 3 つ山の石の数を比較して、石の数がいちばん多い山の位置を求めるだけです。この場合、石をひとつだけ取り除くので、values で山の位置 pos と石の数 (1) の 2 つの値を返します。
safe-position も簡単です。まず、(apply #'logxor nim) でニム和を求めます。そして、取り除く石の数 (num = 石の数 - (石の数 xor ニム和)) を計算して、それが 0 より大きくなる山の位置を求めます。条件を満たす山を見つけたら、return で dotimes を脱出して values で山の位置 x と取り除く石の数 num を返します。
あとはとくに難しいところはないでしょう。詳細はプログラムリストをご覧ください。それでは実行してみましょう。xyzzy Lisp の *scratch* で (nim-game) を評価してください。
(nim-game) (3 5 3) あなたの手番です Input Position (0 - 2) > 1 Input Numbers (1 - 5) > 5 1 から 5 個取ります (3 0 3) 私の手番です 0 から 1 個取ります (2 0 3) あなたの手番です Input Position (0 - 2) > 2 Input Numbers (1 - 3) > 1 2 から 1 個取ります (2 0 2) 私の手番です 0 から 1 個取ります (1 0 2) あなたの手番です Input Position (0 - 2) > 2 Input Numbers (1 - 2) > 1 2 から 1 個取ります (1 0 1) 私の手番です 0 から 1 個取ります (0 0 1) あなたの手番です Input Position (0 - 2) > 2 Input Numbers (1 - 1) > 1 2 から 1 個取ります あなたの勝ちです! nil
今回は三山の初期値が (3 5 3) と簡単だったので、M.Hiroi でも勝つことができました。皆さんも挑戦してみてください。
; ; nim.l : 三山くずし ; ; Copyright (C) 2002 Makoto Hiroi ; ; 乱数の初期化 (setq *random-state* (make-random-state t)) ; 三山を作る (defun make-nim () (let (buffer) (dotimes (x 3 buffer) (push (1+ (random 10)) buffer)))) ; 指し手の入力 (defun input-position (nim) (let (pos num) (loop (format t "~%Input Position (0 - 2) > ") (setq pos (read)) (when (<= 0 pos 2) (format t "Input Numbers (1 - ~D) > " (nth pos nim)) (setq num (read)) (if (and (plusp num) (<= num (nth pos nim))) (return (values pos num)))) (format t "~%Error")))) ; 石がいちばん多い山を求める (defun max-position (nim) (let ((num -1) pos) (dotimes (x 3 (values pos 1)) (if (< num (nth x nim)) (setq pos x num (nth x nim)))))) ; ニム和が 0 になる指し手を求める (defun safe-position (nim) (let ((nim-sum (apply #'logxor nim)) num) (dotimes (x 3) (setq num (- (nth x nim) (logxor (nth x nim) nim-sum))) (if (plusp num) (return (values x num)))))) ; 石を取り除く (defun remove-stone-sub (x nim pos num) (if (= x pos) (cons (- (car nim) num) (cdr nim)) (cons (car nim) (remove-stone-sub (1+ x) (cdr nim) pos num)))) (defun remove-stone (nim pos num) (format t "~D から ~D 個取ります~%" pos num) (remove-stone-sub 0 nim pos num)) ; コンピュータの指し手 (defun move-com (nim) (format t "~%~S 私の手番です~%" nim) (multiple-value-bind (pos num) (if (zerop (apply #'logxor nim)) (max-position nim) (safe-position nim)) (remove-stone nim pos num))) ; プレーヤーの指し手 (defun move-human (nim) (format t "~%~S あなたの手番です~%" nim) (multiple-value-bind (pos num) (input-position nim) (remove-stone nim pos num))) ; ゲームの実行 (defun nim-game () (let ((nim (make-nim)) (turn 0)) (loop (if (oddp turn) (setq nim (move-com nim)) (setq nim (move-human nim))) (when (equal nim '(0 0 0)) (format t "~Aの勝ちです!~%" (if (oddp turn) "私" "あなた")) (return)) (incf turn))))
「生成検定法」で説明したように、パズルの世界では 1 から 9 までの数字を 1 個ずつすべて使った数字を小町数といい、1 から 9 までの数字を 1 個ずつすべて使った式を小町算といいます。今回は小町算の中でも有名なパズルを Lisp で解いてみましょう。それでは問題です。
数字の間に+、-を入れただけでは 100 になる式を作ることはできません。例に示した 78 のように、数字を連結させる処理が必要になります。ここで、数字の連結なんて難しいのではないか、と思われた方もいるでしょう。ところが、簡単に実現できる方法があるのです。それは、数字を連結する演算子を導入することです。この演算子を @ としましょう。すると、例の式は次のように表すことができます。
1 + 2 + 3 - 4 + 5 + 6 + 7 @ 8 + 9 = 100
ようするに、数字の間に 3 種類( +, -, @ )の演算子を入れて数式を生成し、それを計算して 100 になるかチェックすればいいわけです。生成する数式の総数は、1 の前に符号 - がつく場合があるため、2 * 3 の 8 乗 = 13122 通りとなります。
それでは、プログラムを作るときのヒントを出しておきましょう。数式の生成は簡単なのでノーヒントにします。数式を計算する処理は、数値を求める処理と +, - を計算する処理に分けるといいでしょう。数式を (1 + 2 + 3 - 4 + 5 + 6 + 7 @ 8 + 9) のようにリストで表すことにすると、数値を求める手順は次のようになります。
まず、リストからひとつ数値 n1 を取り出し、次の演算子をチェックします。この演算子が +, - であれば、数値をそのまま返します。@ の場合は、次の数値 n2 を取り出して、数値を計算 ( n1 * 10 + n2 ) します。あとは演算子が @ の間、この処理を繰り返せばいいわけです。
+, - を計算する処理は簡単です。数値を求める処理では、読み取った数値や @ をリストから取り除くので、リストの先頭は + か - になります。したがって、次の数値を求めて足し算か引き算を行えばいいわけです。数式を表すリストは、グローバル変数に格納しておくと簡単にプログラムできるでしょう。
それでは、数式を組み立てるプログラムから作りましょう。
List 4 : 数式を組み立てる (defun make-expr (n expr) (if (= n 10) (check (reverse expr)) (dolist (op '(+ - @)) (make-expr (1+ n) (cons n (cons op expr))))))
関数 make-expr は、再帰呼び出しでリストに演算子と数字をセットします。make-expr は (make-expr 2 '(1)) と呼び出します。数式を表すリストは逆順に生成するので、1 に符号 - をつける場合は (make-expr 2 '(1 -)) のように呼び出してください。そして、n が 10 になったら reverse でリストを反転させ、check で数式を計算して 100 になるか確かめます。
List 5 : 計算して確かめる (defun check (expr) (setq *expr* expr) ; グローバル変数にセット (let ((num (get-first-number))) (while *expr* (case (pop *expr*) (+ (incf num (get-number))) (- (decf num (get-number))))) (if (= num 100) (print expr))))
関数 check は、数値を取り出す関数 get-number を用意すると、簡単に作成することができます。まず、数式をグローバル変数 *expr* にセットします。関数 get-first-number は数式から最初の数値を取り出します。これは、数式の先頭に符号 - がつく場合があるので、それを処理します。関数 get-number は、*expr* から数値を取り出して値を返します。このとき、取り出した数字と演算子 @ を *expr* から取り除きます。
数値を取り出したあと、*expr* の先頭の要素は演算子 + か - になります。それを pop で取り出して case で判定します。あとは次の数値を get-number で取り出して、incf または decf で計算すればいいわけです。*expr* が空リストになれば計算は終了です。100 になっていたら数式 expr を print で出力します。
List 6 : 最初の数値を取り出す (defun get-first-number () (cond ((integerp (car *expr*)) (get-number)) ((eq '- (car *expr*)) (pop *expr*) (- (get-number)))))
関数 get-first-number は、*expr* の先頭の要素をチェックします。数値であれば、そのまま get-number を呼び出します。符号 - がついていたならば、get-number で取り出した数値の符号を反転します。
List 7 : 数値を取り出す (defun get-number () (let ((num (pop *expr*))) (while (eq '@ (car *expr*) ) (pop *expr*) (setq num (+ (* num 10) (pop *expr*)))) num))
関数 get-number も簡単です。*expr* の先頭の要素は数値なので、それを取り出して変数 num にセットします。そして、次の演算子が連結を表す @ であれば、次の数値を取り出して計算するだけです。pop に注意してプログラムを読んでくださいね。
それでは実行結果を示しましょう。
(make-expr 2 '(1)) (1 + 2 + 3 - 4 + 5 + 6 + 7 @ 8 + 9) (1 + 2 + 3 @ 4 - 5 + 6 @ 7 - 8 + 9) (1 + 2 @ 3 - 4 + 5 + 6 + 7 @ 8 - 9) (1 + 2 @ 3 - 4 + 5 @ 6 + 7 + 8 + 9) (1 @ 2 + 3 + 4 + 5 - 6 - 7 + 8 @ 9) (1 @ 2 + 3 - 4 + 5 + 6 @ 7 + 8 + 9) (1 @ 2 - 3 - 4 + 5 - 6 + 7 + 8 @ 9) (1 @ 2 @ 3 + 4 - 5 + 6 @ 7 - 8 @ 9) (1 @ 2 @ 3 + 4 @ 5 - 6 @ 7 + 8 - 9) (1 @ 2 @ 3 - 4 - 5 - 6 - 7 + 8 - 9) (1 @ 2 @ 3 - 4 @ 5 - 6 @ 7 + 8 @ 9) nil (make-expr 2 '(1 -)) (- 1 + 2 - 3 + 4 + 5 + 6 + 7 @ 8 + 9) nil
全部で 12 通りの解が出力されます。ところで、今回は数式を表すリストをそのまま出力しているため、演算子 @ が含まれていてわかりづらいですね。これを普通の数式で表示するように改造してみてください。また、数字と演算子をリストに格納しましたが、数字の順番は固定されているので、演算子だけをリストに格納して計算することもできます。
ところで、今回作成したプログラムがベストな方法というわけではありません。ほかにも、いろいろな方法が考えられるでしょう。興味のある方は、もっとクールなプログラムを作ってみてください。