ミニマックス法の続きです。今回はミニマックス法 (アルファベータ法) の改良方法について取り上げます。
ミニマックス法の場合、先手は最も大きな評価値の手を選び、後手は最も小さな評価値の手を選びます。ここで後手番のときに評価値の符号を反転すると、先手と同様に後手でも最大な評価値の手を選べばよいことになります。つまり、手番を変えて思考ルーチンを呼び出すときは、その返り値 (評価値) にマイナス符号をつけて符号を反転させるわけです。この方法を「ネガマックス法 (nega-max method)」といいます。
ネガマックス法は、先手番でも後手番でも評価値が最大となる指し手を選ぶようになるため、プログラムはミニマックス法よりも簡単になります。なお、ネガマックス法の動作はミニマックス法とまったく同じです。
プログラムは次のようになります。
リスト : ネガマックス法
(defun nega-max (turn xs pass)
(if (null xs)
(values (get-value turn) nil) ; ゲーム終了 (空き場所なし)
(let ((value min-value) move)
(dolist (x xs)
(let ((rs (get-rev-stone x turn)))
(when rs
(reverse-stone rs turn)
(put-piece x turn)
(multiple-value-bind
(v m)
(nega-max (change-turn turn) (remove x xs) nil)
(setq v (- v))
(del-piece x)
(reverse-stone rs (change-turn turn))
;; ミニマックス法
(when (< value v)
(setq value v move (cons x m)))))))
(if (not move)
(if pass
(values (get-value turn) (list 'pass)) ; ゲーム終了 (両者ともにパス)
(multiple-value-bind
(v m)
(nega-max (change-turn turn) xs t)
(values (- v) (cons 'pass m))))
(values value move)))))
前回のミニマックス法は関数 think-black と think-white の相互再帰になりましたが、ネガマックス法は関数 nega-max の再帰呼び出しだけでプログラムすることができます。引数 TURN は手番を表します。先手をシンボル B で、後手をシンボル W で表します。
関数 get-value で評価値を求めるとき、手番が後手であれば評価値の符号を反転します。手番を変える場合、nega-max を再帰呼び出しして、返り値 (評価値) V の符号を反転します。ネガマックス法における指し手の選択処理も簡単です。V が VALUE よりも大きいときに、その指し手を選ぶだけです。このようにプログラムを簡単に記述できるのがネガマックス法の長所です。
次はネガマックス法に対応したアルファベータ法のプログラムを説明します。これを「ネガアルファ法 (nega-α method)」と呼びます。次のリストを見てください。
リスト : ネガアルファ法
(defun nega-alpha (turn xs pass limit)
(if (null xs)
(values (get-value turn) nil) ; ゲーム終了 (空き場所なし)
(let ((value min-value) move)
(dolist (x xs)
(let ((rs (get-rev-stone x turn)))
(when rs
(reverse-stone rs turn)
(put-piece x turn)
(multiple-value-bind
(v m)
(nega-alpha (change-turn turn) (remove x xs) nil (- value))
(setq v (- v))
(del-piece x)
(reverse-stone rs (change-turn turn))
;; ミニマックス法
(when (< value v)
;; アルファベータ法
(when (<= limit v)
(return-from nega-alpha (values v (cons x m))))
(setq value v move (cons x m)))))))
(if (not move)
(if pass
(values (get-value turn) (list 'pass)) ; ゲーム終了 (両者ともにパス)
(multiple-value-bind
(v m)
(nega-alpha (change-turn turn) xs t (- value))
(values (- v) (cons 'pass m))))
(values value move)))))
引数 LIMIT が基準値になります。ネガアルファ法の場合、手番を変えるときは基準値の符号を反転して渡すことに注意してください。前回のアルファベータ法の場合、基準値として VALUE を渡しましたが、ネガアルファ法の場合は (- value) を渡します。そうすると、ネガアルファ法による枝刈りの条件は (<= limit v) で表すことができます。このように、ネガアルファ法のプログラムもとても簡単になります。
ところで、今までのアルファベータ法のプログラムでは、次の局面の基準値となる変数 value の値を MIN-VALUE または MAX-VALUE で初期化しているため、最初に探索する局面 (最も左側の枝の局面) の評価値を求めないと、アルファベータ法による枝刈りは発生しません。α値とβ値を (α, β) で表すと、新しい局面は (-∞, β) または (α, ∞) の幅で局面を探索することになります。たとえば、左側の枝から順番に探索していく場合、最も左側の枝の評価値 value が求まると、それ以降の枝は (value, β) または (α, value) の幅で局面を探索します。
これに対し、一つ前の局面で求まったα値とβ値を使っても、アルファベータ法を動作させることができます。つまり、新しい局面でも (α, β) の幅でゲーム木を探索してもいいのです。(-∞, β) または (α, ∞) で探索を始めるよりも (α, β) の方が幅が狭くなるので、枝刈り (αカット、βカット) の回数が多くなることが期待できます。
Ｒ 先手の局面
／ ＼
／ ＼
／ ＼
／ ＼
／ ＼
Ａ(3) Ｂ(2) 後手の局面
／ ＼ ／ ×
／ ＼ ／ ×
Ｃ(3) Ｄ(4) Ｅ(2) Ｆ(5) 先手の局面
／ ＼ ／ × ／ ＼ ／ ＼
Ｇ Ｈ Ｉ Ｊ Ｋ Ｌ Ｍ Ｎ 後手の局面
１ ３ ４ ２ ２ １ ３ ５ 評価値
× × ×
図 : アルファベータ法
これで正しく動作することを、前回示したアルファベータ法の図を使って確かめてみましょう。アルファベータ法の図を再掲します。局面 A の評価は次の図のようになります。
後手の局面 Ａ
／ ＼
／ ＼
先手の局面 Ｃ Ｄ
／ ＼ ／ ×
後手の局面 Ｇ Ｈ Ｉ Ｊ
評価値 １ ３ ４
(1) R = (-∞, ∞) -> A = (-∞, ∞) -> C = (-∞, ∞)
(2) G を評価 => 1, C = (1, ∞)
(3) H を評価 => 3, C = (3, ∞)
(4) C の評価 => 3, A = (-∞, 3)
(5) A = (-∞, 3) -> D = (-∞, 3)
(6) I を評価 => 4, D = (4, 3) 4 >= 3 なのでβカット
(7) D の評価 => 4, A = (-∞, 3)
(8) A の評価 => 3, R = (3, ∞)
図 : ベータカット
局面 R のα値とβ値は R = (-∞, ∞) になります。この値が渡されていくので、局面 C も C = (-∞, ∞) になります。次に、局面 G の評価値を求めると 1 になります。局面 C は先手の局面なので、α値と評価値を比較して大きな値を選びます。したがって、C = (1, ∞) になります。次に G の局面を評価して C = (3, ∞) になります。そして、局面 C の評価値はα値の 3 になります。
局面 A は後手の局面なので、評価値とβ値を比較して小さな値を選びます。C の評価値は 3 なので、A = (-∞, 3) になります。次に局面 D を評価します。α値とβ値は局面 A の値が渡されるので D = (-∞, 3) になります。そして、局面 I を評価します。I の値は 4 になるので、D = (4, 3) になり α値 >= β値 の条件を満たします。ここでβカットされて、局面 D の評価値は 4 になります。
局面 A に戻って、D の評価値 4 とβ値 3 を比較します。β値のほうが小さいので、D は選択されません。 A = (-∞, 3) のままです。そして、β値 3 が返されて、局面 R に戻ります。R は先手の局面なのでα値と評価値を比較して大きな値を選択します。したがって、R = (3, ∞) になります。
次に、局面 B の評価を下図に示します。
Ｒ
／ ＼
／ ＼
後手の局面 Ａ Ｂ
／ ×
／ ×
先手の局面 Ｅ Ｆ
／ ＼
後手の局面 Ｋ Ｌ
評価値 ２ １
(1) R = (3, ∞) -> B = (3, ∞) -> E = (3, ∞)
(2) K を評価 => 2, E = (3, ∞)
(3) L を評価 => 1, E = (3, ∞)
(4) E の評価 => 3, B = (3, 3) 3 >= 3 なのでαカット
(5) B の評価 => 3, R = (3, ∞)
(6) R の評価 => 3, (A を選択する)
図 : アルファカット
R = (3, ∞) の値が渡されていくので、局面 E も E = (3, ∞) になります。次に、K を評価します。評価値は 2 でα値 3 よりも小さいので、この局面は選択されません。次に、局面 L を評価しますが、評価値が 1 なのでこの局面も選択されません。このように、α値よりも小さな評価値の局面しか存在しない場合、局面を選択することができなくなります。
この場合、2 通りの方法があります。一つはα値を E の評価値として返す方法です。既にα値が 3 となる局面が見つかっているので、これよりも小さな局面が選択されることはありません。正確な評価値がわからなくても、α値以下であることがわかればアルファベータ法は動作します。評価値として 3 を返すと、上図 (4) のように B = (3, 3) になるので、条件 α値 >= β値 を満たしてαカットされます。
もう一つは最も大きな評価値を返す方法です。上図の場合では、局面 K の評価値 2 を返します。この方法を「fail soft [*1] アルファベータ法」と呼びます。アルファベータ法 (ネガアルファ法) の場合、どちらの方法でも正常に動作します。前者の場合、B の評価値は 3 になり、後者の場合は 2 になりますが、どちらの場合でも局面 A が選択されます。
この fail soft をうまく使った方法に window search があります。window とはα値とβ値の幅 (α, β) のことです。アルファベータ法でゲーム木を探索する場合、ルートの局面では (-∞, ∞) を指定するのが普通ですが、window search は window の幅を狭めて探索を行います。とくに、window の幅を極端に狭めて (α, α + 1) に制限する方法を null window search といいます。ネガスカウト (NegaScout) 法や MTD(f) 法は null window search を使って、アルファベータ法よりも効率よくゲーム木を探索することができます。
それではプログラムを作りましょう。次のリストを見てください。
リスト : ネガアルファ法の改良 (fail soft 対応版)
(defun nega-alpha2 (turn xs pass alpha beta)
(if (null xs)
(values (get-value turn) nil) ; ゲーム終了 (空き場所なし)
(let ((value min-value) move)
(dolist (x xs)
(let ((rs (get-rev-stone x turn)))
(when rs
(reverse-stone rs turn)
(put-piece x turn)
(multiple-value-bind
(v m)
(nega-alpha2 (change-turn turn) (remove x xs) nil (- beta) (- (max alpha value)))
(setq v (- v))
(del-piece x)
(reverse-stone rs (change-turn turn))
;; ミニマックス法
(when (< value v)
;; アルファベータ法
(when (<= beta v)
(return-from nega-alpha2 (values v (cons x m))))
(setq value v move (cons x m)))))))
(if (not move)
(if pass
(values (get-value turn) (list 'pass)) ; ゲーム終了 (両者ともにパス)
(multiple-value-bind
(v m)
(nega-alpha2 (change-turn turn) xs t (- beta) (- alpha))
(values (- v) (cons 'pass m))))
(values value move)))))
引数 ALPHA がα値、beta がβ値です。VALUE は MIN-VALUE で初期化します。これで ALPHA よりも小さな評価値の局面しか見つからない場合でも、VALUE にはその中の最大値がセットされます。評価値 V が BETA 以上になったら枝刈りを行うところは今までと同じです。
ネガアルファ法を使っているので、手番を変えて nega-max を再帰呼び出しするときは符号を反転するとともに、α値とβ値を逆にして渡すことと、ALPHA と VALUE の大きいほうを関数 max で選んで渡すことに注意してください。
それでは、実行結果を示しましょう。ゲームの結果は、当然ですがアルファベータ法とネガアルファ法改良版 (fail soft 対応) で変わりはありません。改良版の効果を確かめるため、局面を評価した回数をカウントして比較してみましょう。改良方法が有効に機能すれば、アルファベータ法よりも局面の評価回数は少なくなるはずです。結果は次のようになりました。
表 : 局面の評価回数
| W B | W B
初期値 | B W | W B
---------+-------+-------
minimax | 60060 | 67116
ab | 10016 | 13590
順序変更 | 2387 | 4832
failsoft | 718 | 1059
fail soft 対応版の評価回数は大幅に減少しています。改良の効果はとても大きいですね。ゲーム木を探索する場合、(α, β) の範囲を狭める方法は有効であることがわかります。
fail soft を使うと、もう少し大きな盤面でも高速に解くことができます。たとえば、4 行 6 列盤 (長方形) の解は次のようになりました。
初期値
W B
B W
* (solver)
value = 16
B : 11 W : 10 B : 9 W : 35
B = 4 : W = 1 B = 3 : W = 3 B = 5 : W = 2 B = 4 : W = 4
S S B S S S S W B S S S B B B S S S B B B S S S
S S B B S S S S W B S S S S W B S S S S W B S S
S S B W S S S S B W S S S S B W S S S S W W S S
S S S S S S S S S S S S S S S S S S S S W S S S
B : 18 W : 13 B : 37 W : 21
B = 6 : W = 3 B = 5 : W = 5 B = 7 : W = 4 B = 6 : W = 6
B B B S S S B B B S W S B B B S W S B B B S W S
S B B B S S S B B W S S S B B W S S S B B W W S
S S W W S S S S W W S S S S W B S S S S W W S S
S S W S S S S S W S S S S S W S B S S S W S B S
B : 29 W : 12 B : 14 B : 36
B = 8 : W = 5 B = 7 : W = 7 B = 10 : W = 5 B = 13 : W = 4
B B B S W S B B B W W S B B B B B B B B B B B B
S B B B W S S B B W W S S B B W W S S B B B W S
S S W W B S S S W W B S S S W W B S S S B B W S
S S W S B S S S W S B S S S W S B S S S W B B W
W : 26 B : 33 W : 17 B : 25
B = 11 : W = 7 B = 13 : W = 6 B = 9 : W = 11 B = 12 : W = 9
B B B B B B B B B B B B B B B B B B B B B B B B
S B B B W S S B B B W S W W W W W S B B W W W S
S W W W W S S B W W W S S W W W W S B W W W W S
S S W B B W B S W B B W B S W B B W B S W B B W
W : PASS!!
B : 22 W : 30 B : 34
B = 17 : W = 5 B = 16 : W = 7 B = 20 : W = 4
B B B B B B B B B B B B B B B B B B
B B B B B B B B B B B B B B B B B B
B W W W B S B W W W W W B B B W W W
B S W B B W B S W B B W B B B B B W
初期値
W B
W B
* (solver)
value = 18
B : 10 W : 29 B : 36 W : 11
B = 4 : W = 1 B = 3 : W = 3 B = 5 : W = 2 B = 3 : W = 5
S B S S S S S B S S S S S B S S S S S B W S S S
S S B B S S S S B B S S S S B B S S S S W W S S
S S W B S S S S W W W S S S W B W S S S W B W S
S S S S S S S S S S S S S S S B S S S S S B S S
B : 12 W : 21 B : 35 W : 26
B = 6 : W = 3 B = 5 : W = 5 B = 8 : W = 3 B = 6 : W = 6
S B B B S S S B B B S S S B B B S S S B B B S S
S S W B S S S S W W W S S S B W W S S S B W W S
S S W B W S S S W B W S S S B B W S S W W W W S
S S S B S S S S S B S S S S B B S S S S B B S S
B : 33 W : 25 B : 37 W : 18
B = 8 : W = 5 B = 7 : W = 7 B = 9 : W = 6 B = 8 : W = 8
S B B B S S S B B B S S S B B B S S S B B B S S
S S B W W S S S B W W S S S B W W S S W W W W S
S B W W W S W W W W W S W W W B W S W W W B W S
B S B B S S B S B B S S B S B B B S B S B B B S
B : 38 W : 30 B : 14 W : 13
B = 11 : W = 6 B = 9 : W = 9 B = 12 : W = 7 B = 10 : W = 10
S B B B S S S B B B S S S B B B S B S B B B W B
S W W B W S S W W B W S S W W B B S S W W W W S
W W W B B S W W W W W W W W W B W W W W W B W W
B S B B B B B S B B B B B S B B B B B S B B B B
B : 9 W : 34 B : 17
B = 13 : W = 8 B = 12 : W = 10 B = 15 : W = 8
B B B B W B B B B B W B B B B B W B
S B W W W S S B W W W S B B W W W S
W W B B W W W W W B W W B B W B W W
B S B B B B B W B B B B B W B B B B
W : PASS!!
B : 22
B = 21 : W = 3
B B B B W B
B B B B B B
B B W B B B
B W B B B B
表 : 局面の評価回数
| W B | W B
初期値 | B W | W B
---------+----------+----------
ab | 22029381 | 20608101
failsoft | 211710 | 513340
結果はどちらの初期値でも先手必勝でした。局面の評価回数は fail soft のほうが大幅に少なくなり、実行時間もアルファベータ法が数分かかるところを、fail soft では数秒で終わります。初手を限定すると、実行時間をさらに短縮することができます。興味のある方は試してみてください。
;;;
;;; rev16nega.lisp : 4 行 4 列盤リバーシ
;;;
;;; Copyright (C) 2020 Makoto Hiroi
;;;
;;; 盤面の初期値
;;; o: 壁, s: 空き場所, b: 黒石, w: 白石
(defconstant init-board
'(o o o o o o
o s s s s o
o s w b s o
o s b w s o
o s s s s o
o o o o o o))
(defconstant direction '(1 -1 6 -6 7 -7 5 -5)) ; 方向
(defconstant max-value 50)
(defconstant min-value -50)
(defvar *board*) ; 盤面
(defvar *black*) ; 黒石の個数
(defvar *white*) ; 白石の個数
(defvar *count*) ; 評価回数
;;; アクセス関数
(defun get-piece (x) (aref *board* x))
(defun put-piece (x p)
(case
p
(b (incf *black*))
(w (incf *white*)))
(setf (aref *board* x) p))
(defun del-piece (x)
(case
(get-piece x)
(b (decf *black*))
(w (decf *white*)))
(setf (aref *board* x) 's))
;;; 評価値を求める
(defun get-value (turn)
(incf *count*)
(if (eq turn 'b)
(- *black* *white*)
(- *white* *black*)))
;;; 手番の変更
(defun change-turn (turn)
(if (eq turn 'b) 'w 'b))
;;; 反転する石を求める
(defun get-rev-stone-sub (n p q d &optional a)
(cond
((eq (get-piece n) p) a)
((eq (get-piece n) q)
(get-rev-stone-sub (+ n d) p q d (cons n a)))
(t nil)))
(defun get-rev-stone (n p)
(let ((q (if (eq p 'b) 'w 'b)))
(mapcan (lambda (d) (get-rev-stone-sub (+ n d) p q d))
direction)))
;;; 石を反転する
(defun reverse-stone (xs p)
(mapc (lambda (x) (put-piece x p)) xs)
(case
p
(b (decf *white* (length xs)))
(w (decf *black* (length xs)))))
;;;
;;; ネガマックス法
;;;
(defun nega-max (turn xs pass)
(if (null xs)
(values (get-value turn) nil) ; ゲーム終了 (空き場所なし)
(let ((value min-value) move)
(dolist (x xs)
(let ((rs (get-rev-stone x turn)))
(when rs
(reverse-stone rs turn)
(put-piece x turn)
(multiple-value-bind
(v m)
(nega-max (change-turn turn) (remove x xs) nil)
(setq v (- v))
(del-piece x)
(reverse-stone rs (change-turn turn))
;; ミニマックス法
(when (< value v)
(setq value v move (cons x m)))))))
(if (not move)
(if pass
(values (get-value turn) (list 'pass)) ; ゲーム終了 (両者ともにパス)
(multiple-value-bind
(v m)
(nega-max (change-turn turn) xs t)
(values (- v) (cons 'pass m))))
(values value move)))))
;;;
;;; ネガアルファ法
;;;
(defun nega-alpha (turn xs pass limit)
(if (null xs)
(values (get-value turn) nil) ; ゲーム終了 (空き場所なし)
(let ((value min-value) move)
(dolist (x xs)
(let ((rs (get-rev-stone x turn)))
(when rs
(reverse-stone rs turn)
(put-piece x turn)
(multiple-value-bind
(v m)
(nega-alpha (change-turn turn) (remove x xs) nil (- value))
(setq v (- v))
(del-piece x)
(reverse-stone rs (change-turn turn))
;; ミニマックス法
(when (< value v)
;; アルファベータ法
(when (<= limit v)
(return-from nega-alpha (values v (cons x m))))
(setq value v move (cons x m)))))))
(if (not move)
(if pass
(values (get-value turn) (list 'pass)) ; ゲーム終了 (両者ともにパス)
(multiple-value-bind
(v m)
(nega-alpha (change-turn turn) xs t (- value))
(values (- v) (cons 'pass m))))
(values value move)))))
;;;
;;; ネガアルファ法 (fail-soft 対応版)
;;;
(defun nega-alpha2 (turn xs pass alpha beta)
(if (null xs)
(values (get-value turn) nil) ; ゲーム終了 (空き場所なし)
(let ((value min-value) move)
(dolist (x xs)
(let ((rs (get-rev-stone x turn)))
(when rs
(reverse-stone rs turn)
(put-piece x turn)
(multiple-value-bind
(v m)
(nega-alpha2 (change-turn turn) (remove x xs) nil (- beta) (- (max alpha value)))
(setq v (- v))
(del-piece x)
(reverse-stone rs (change-turn turn))
;; ミニマックス法
(when (< value v)
;; アルファベータ法
(when (<= beta v)
(return-from nega-alpha2 (values v (cons x m))))
(setq value v move (cons x m)))))))
(if (not move)
(if pass
(values (get-value turn) (list 'pass)) ; ゲーム終了 (両者ともにパス)
(multiple-value-bind
(v m)
(nega-alpha2 (change-turn turn) xs t (- beta) (- alpha))
(values (- v) (cons 'pass m))))
(values value move)))))
;;; 盤面の表示
(defun print-line (xs)
(mapc (lambda (x) (format t "~s " (get-piece x))) xs)
(terpri))
(defun print-board ()
(dolist (xs '((7 8 9 10) (13 14 15 16) (19 20 21 22) (25 26 27 28)))
(print-line xs))
(terpri))
;;; 手順の表示
(defun print-move (ls)
(let ((turn 'B))
(dolist (x ls)
(cond
((eq x 'pass)
(format t "~s : PASS!!~%" turn))
(t
(format t "~s : ~d~%" turn x)
(reverse-stone (get-rev-stone x turn) turn)
(put-piece x turn)
(format t "B = ~d : W = ~d~%" *black* *white*)
(print-board)))
(setq turn (if (eq turn 'b) 'w 'b)))))
;;; 解法
(defun solver ()
(setq *board* (make-array (length init-board) :initial-contents init-board)
*white* 2
*black* 2
*count* 0)
(multiple-value-bind
(v m)
;(nega-max 'b '(7 8 9 10 13 16 19 22 25 26 27 28) nil)
;(nega-alpha 'b '(7 8 9 10 13 16 19 22 25 26 27 28) nil max-value)
;(nega-alpha 'b '(7 10 25 28 8 9 13 16 19 22 26 27) nil max-value)
(nega-alpha2 'b '(7 10 25 28 8 9 13 16 19 22 26 27) nil min-value max-value)
(format t "value = ~d~%" v)
(print-move m)
(print *count*)))
;;;
;;; rev24a.lisp : 4 行 6 列盤リバーシ
;;;
;;; Copyright (C) 2020 Makoto Hiroi
;;;
;;; 盤面の初期値
;;; o: 壁, s: 空き場所, b: 黒石, w: 白石
(defconstant init-board
'(o o o o o o o o
o s s s s s s o ; 9 10 11 12 13 14
o s s w b s s o ; 17 18 19 20 21 22
o s s w b s s o ; 25 26 27 28 29 30
o s s s s s s o ; 33 34 35 36 37 38
o o o o o o o o))
(defconstant direction '(1 -1 8 -8 9 -9 7 -7)) ; 方向
(defconstant max-value 50)
(defconstant min-value -50)
(defconstant space-list
'( 9 14 33 38 11 12 35 36 10 13
34 37 17 25 22 30 18 26 21 29))
(defvar *board*) ; 盤面
(defvar *black*) ; 黒石の個数
(defvar *white*) ; 白石の個数
(defvar *count*) ; 評価回数
;;; アクセス関数
(defun get-piece (x) (aref *board* x))
(defun put-piece (x p)
(case
p
(b (incf *black*))
(w (incf *white*)))
(setf (aref *board* x) p))
(defun del-piece (x)
(case
(get-piece x)
(b (decf *black*))
(w (decf *white*)))
(setf (aref *board* x) 's))
;;; 評価値を求める
(defun get-value (turn)
(incf *count*)
(if (eq turn 'b)
(- *black* *white*)
(- *white* *black*)))
;;; 手番の変更
(defun change-turn (turn)
(if (eq turn 'b) 'w 'b))
;;; 反転する石を求める
(defun get-rev-stone-sub (n p q d &optional a)
(cond
((eq (get-piece n) p) a)
((eq (get-piece n) q)
(get-rev-stone-sub (+ n d) p q d (cons n a)))
(t nil)))
(defun get-rev-stone (n p)
(let ((q (if (eq p 'b) 'w 'b)))
(mapcan (lambda (d) (get-rev-stone-sub (+ n d) p q d))
direction)))
;;; 石を反転する
(defun reverse-stone (xs p)
(mapc (lambda (x) (put-piece x p)) xs)
(case
p
(b (decf *white* (length xs)))
(w (decf *black* (length xs)))))
;;;
;;; ネガアルファ法
;;;
(defun nega-alpha (turn xs pass limit)
(if (null xs)
(values (get-value turn) nil) ; ゲーム終了 (空き場所なし)
(let ((value min-value) move)
(dolist (x xs)
(let ((rs (get-rev-stone x turn)))
(when rs
(reverse-stone rs turn)
(put-piece x turn)
(multiple-value-bind
(v m)
(nega-alpha (change-turn turn) (remove x xs) nil (- value))
(setq v (- v))
(del-piece x)
(reverse-stone rs (change-turn turn))
;; ミニマックス法
(when (< value v)
;; アルファベータ法
(when (<= limit v)
(return-from nega-alpha (values v (cons x m))))
(setq value v move (cons x m)))))))
(if (not move)
(if pass
(values (get-value turn) (list 'pass)) ; ゲーム終了 (両者ともにパス)
(multiple-value-bind
(v m)
(nega-alpha (change-turn turn) xs t (- value))
(values (- v) (cons 'pass m))))
(values value move)))))
;;;
;;; ネガアルファ法 (fail-soft 対応版)
;;;
(defun nega-alpha2 (turn xs pass alpha beta)
(if (null xs)
(values (get-value turn) nil) ; ゲーム終了 (空き場所なし)
(let ((value min-value) move)
(dolist (x xs)
(let ((rs (get-rev-stone x turn)))
(when rs
(reverse-stone rs turn)
(put-piece x turn)
(multiple-value-bind
(v m)
(nega-alpha2 (change-turn turn) (remove x xs) nil (- beta) (- (max alpha value)))
(setq v (- v))
(del-piece x)
(reverse-stone rs (change-turn turn))
;; ミニマックス法
(when (< value v)
;; アルファベータ法
(when (<= beta v)
(return-from nega-alpha2 (values v (cons x m))))
(setq value v move (cons x m)))))))
(if (not move)
(if pass
(values (get-value turn) (list 'pass)) ; ゲーム終了 (両者ともにパス)
(multiple-value-bind
(v m)
(nega-alpha2 (change-turn turn) xs t (- beta) (- alpha))
(values (- v) (cons 'pass m))))
(values value move)))))
;;; 盤面の表示
(defun print-board ()
(let ((i 0))
(dotimes (x (length *board*) (terpri))
(if (eq (get-piece x) 'O)
(format t " ")
(format t "~S " (get-piece x)))
(incf i)
(when (= i 8)
(terpri)
(setq i 0)))))
;;; 手順の表示
(defun print-move (ls)
(let ((turn 'B))
(dolist (x ls)
(cond
((eq x 'pass)
(format t "~s : PASS!!~%" turn))
(t
(format t "~s : ~d~%" turn x)
(reverse-stone (get-rev-stone x turn) turn)
(put-piece x turn)
(format t "B = ~d : W = ~d~%" *black* *white*)
(print-board)))
(setq turn (if (eq turn 'b) 'w 'b)))))
;;; 解法
(defun solver ()
(setq *board* (make-array (length init-board) :initial-contents init-board)
*white* 2
*black* 2
*count* 0)
(multiple-value-bind
(v m)
;(nega-alpha 'b space-list nil max-value)
(nega-alpha2 'b space-list nil min-value max-value)
(format t "value = ~d~%" v)
(print-move m)
(print *count*)))