今回はアルファベータ法の改良法である「ネガスカウト (Nega Scout) 法」について説明します。ゲームは 4 行 6 列盤リバーシを使います。
まず最初に null window search について簡単に説明します。null window search は window の幅を (α, α + 1) のように制限してアルファベータ法による探索を行います。window の幅がとても狭いため、通常のアルファベータ法よりも多くの枝刈りが発生し、高速に探索することができます。
ただし、null winodow search で正確な評価値を求めることはできません。ミニマックス法で求められる正確な評価値を v、window の幅を (a, a + 1) とすると、null window search は次の条件を満たす評価値 x を返します。
(1) v <= x <= a (2) a + 1 <= x <= v
(1) の場合を fail-low といい、(2) の場合を fail-high といいます。fail-low の場合、正しい評価値 v は x 以下であることがわかります。また、fail-high の場合、v は x 以上であることがわかります。つまり、null window search を使うと、評価値が a よりも大きいか小さいかを高速に判定することができるわけです。
null window search を使った探索方法には、ネガスカウト (NegaScout) 法や MTD(f) 法などがありますが、今回はネガスカウト法を取り上げます。ネガスカウト法は null window search を使って、アルファベータ法の探索で winodw の幅を絞り込む方法です。
たとえば、winodw の幅が (a, b) のときに (a, a + 1) で null window search を行ってみましょう。返り値 x が fail-low の場合、正確な評価値は a 以下であることが保障されているので、評価値はα値以下であることが確定します。したがって、この局面が選択されることはありません。探索は null window search だけでよく、正確な評価値を求める必要はありません。
次に、返り値 x が b 以上の場合、正確な評価値は x 以上であることが保障されているので、β値以上であることが確定します。したがって、ここで枝刈りすることができます。この場合も null window search で求めた評価値 x だけで十分です。
最後に、a < x < b の場合ですが、正確な評価値は x 以上であることが保障されているので、window の幅を (x, b) に設定してアルファベータ法で正確な評価値を求めます。幅が (x, b) と制限される分だけ、効率的に探索することができます。
ネガスカウト法の場合、最初に探索する (最も左側の枝の) 局面は通常のネガアルファ法で評価値を求め、そのあとに探索する局面に対して null window search を適用します。高い評価値の局面から順番に探索した場合、最初の評価値を求めたあと、そのあとの局面は最初の評価値よりも大きくならないことを null window search で確認するだけですみます。このため、ネガスカウト法は move ordering と一緒に用いられることが多いようです。
ネガスカウト法のプログラムは次のようになります。
リスト : ネガスカウト法
(defun nega-scout (turn xs pass alpha beta)
(if (null xs)
(values (get-value turn) nil) ; ゲーム終了 (空き場所なし)
(let ((value min-value) move)
(dolist (x xs)
(let ((a (max alpha value))
(rs (get-rev-stone x turn)))
(when rs
(reverse-stone rs turn)
(put-piece x turn)
;; null window search
(multiple-value-bind
(v m)
(nega-scout (change-turn turn) (remove x xs) nil (- (1+ a)) (- a))
(setq v (- v))
(when (> beta v a)
;; 再度探索する
(multiple-value-bind
(v1 m1)
(nega-scout (change-turn turn) (remove x xs) nil (- beta) (- v))
(setq v (- v1) m m1)))
(del-piece x)
(reverse-stone rs (change-turn turn))
;; ミニマックス法
(when (< value v)
;; アルファベータ法
(when (<= beta v)
(return-from nega-scout (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-scout (change-turn turn) xs t (- beta) (- alpha))
(values (- v) (cons 'pass m))))
(values value move)))))
手番を変えるときに null window search を適用します。また、最初に探索する局面でも null window search を適用することにします。一般的なネガスカウト法とはちょっと違いますが、ミニミニリバーシの場合はこれでも十分に機能するようです。
手番を変える場合、最初に ALPHA と VALUE を比較して大きいほうを変数 A にセットします。そして、window の幅を (-(A+1), -A) に制限して関数 nega-scout を再帰呼び出しします。これで null window search が実行されます。プログラムはネガアルファ法で実装しているので、null window search の幅 (A, A+1) は、符号を反転してα値とβ値を逆にすることに注意してください。
評価値 V が A よりも大きくて BETA よりも小さい場合は、window の幅を (V, BETA) に設定してネガアルファ法で再探索します。これで正しい評価値を求めることができます。あとはネガアルファ法と同じで、V が VALUE よりも大きい場合はその局面を選択し、BETA 以上の場合は枝刈りを行います。
それでは、実行結果を示しましょう。ゲームの結果は、当然ですがネガアルファ法 fail soft 対応版とネガスカウト法で変わりはありません。ただし、ネガアルファ法とネガスカウト法では求まる手順が異なるので注意してください。ネガスカウト法の効果を確かめるため、局面を評価した回数をカウントして比較してみましょう。ネガスカウト法が有効に機能すれば、ネガアルファ法 fail soft 対応版よりも局面の評価回数は少なくなるはずです。結果は次のようになりました。
表 : 局面の評価回数
| W B | W B
初期値 | B W | W B
---------+---------+---------
failsoft | 211710 | 513340
negascout| 173668 | 496740
評価回数はネガアルファ法 fail soft 対応版よりもネガスカウト法の方が少なくなりました。ネガスカウト法の効果は十分に出ていると思います。興味のある方はいろいろ試してみてください。
;;;
;;; rev24b.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 b w 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)))))
;;;
;;; ネガアルファ法 (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 nega-scout (turn xs pass alpha beta)
(if (null xs)
(values (get-value turn) nil) ; ゲーム終了 (空き場所なし)
(let ((value min-value) move)
(dolist (x xs)
(let ((a (max alpha value))
(rs (get-rev-stone x turn)))
(when rs
(reverse-stone rs turn)
(put-piece x turn)
;; null window search
(multiple-value-bind
(v m)
(nega-scout (change-turn turn) (remove x xs) nil (- (1+ a)) (- a))
(setq v (- v))
(when (> beta v a)
;; 再度探索する
(multiple-value-bind
(v1 m1)
(nega-scout (change-turn turn) (remove x xs) nil (- beta) (- v))
(setq v (- v1) m m1)))
(del-piece x)
(reverse-stone rs (change-turn turn))
;; ミニマックス法
(when (< value v)
;; アルファベータ法
(when (<= beta v)
(return-from nega-scout (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-scout (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)
(nega-scout 'b space-list nil min-value max-value)
(format t "value = ~d~%" v)
(print-move m)
(print *count*)))
今回は「置換表 (transposition table)」と「MTD(f) 法」を取り上げます。
置換表は局面の情報を格納しておく表 (table) のことです。ゲーム木の探索では、同じ局面が何度も現れることがよくあります。同じ局面を何度も探索するのは時間の無駄なので、すでに探索した局面はその情報 (評価値、手番、探索の深さなど) を表に格納しておき、同一局面が現れたら表の情報を再利用します。表の情報が十分なものであれば、そこで探索を打ち切って、評価値をそのまま返すことができます。もし、情報が不十分な場合でも、それを基にして探索を続行し、その結果で表の情報を更新します。
一般に、何度も同じ値を計算することがないように、計算した値は表に格納しておいて、2 回目以降は表から計算結果を求めることでプログラムを高速化する手法を「表計算法」といいます。表を使うアルゴリズムというと、有名なところでは「動的計画法」があります。置換表は表計算法の一種と考えることができます。置換表はチェス、将棋、リバーシなどのプログラムでよく用いられる手法です。置換表は「ハッシュ法」を使って実装するのが一般的です。今回は Common Lisp の「ハッシュ表」を使って置換表をプログラムしてみましょう。
Ｒ レベル０
／ ＼
／ ＼
／ ＼
／ ＼
／ ＼
Ａ Ｂ レベル１
／ ＼ ／ ＼
／ ＼ ／ ＼
Ｃ Ｄ Ｅ Ｆ レベル２
／ ＼ ／ ＼ ／ ＼ ／ ＼
Ｇ Ｈ Ｉ Ｊ Ｋ Ｌ Ｍ Ｎ レベル３
図 : ゲーム木
まずは最初にミニミニリバーシ (4 行 4 列盤) のネガマックス法に置換表を適用して、どの程度の効果があるか確かめてみましょう。ネガマックス法の場合、置換表に登録するデータは評価値、指し手、手番、探索の深さなどがあります。とくに、探索の深さは重要な情報です。上の図を見てください。
たとえば、探索レベルが 5 で、局面 J と B が同じだったとしましょう。この場合、置換表には J の評価値が登録されますが、局面 B にこの評価値を適用することはできません。J はレベル 3 の局面なので、このあと 2 手先読みした局面の中から J の評価値が求まります。局面 B はレベル 1 なので、あと 4 手先読みしないと探索レベルが 5 に到達しません。つまり、F で J の評価値を適用すると、探索レベルが 3 に下がってしまうのです。
逆に、レベル 1 の局面 A とレベル 3 の局面 N が同じだった場合、A の評価値を N に適用すると、その探索レベルは 7 に上がります。つまり、2 レベル分だけ深くゲーム木を探索できたことになります。この場合、置換表の評価値を採用して、N の評価値として A の評価値を返しても問題ありません。また、同じレベルの局面の場合も置換表の評価値をそのまま利用することができます。
このように、探索の深さにより置換表の情報を採用するか否かを決定することができます。ただし、今回のミニミニリバーシのようにゲーム終了まで読み切る場合、探索の深さを考慮する必要はありません。手番と局面からキーを生成して、評価値と指し手を置換表に登録することにします。
最初に手番と盤面からキーを生成する関数を作ります。
リスト : キーの生成
(defun board-to-key (turn)
(reduce
(lambda (a x)
(case
(get-piece x)
(b (+ (* a 3) 2))
(w (+ (* a 3) 1))
(otherwise (* a 3))))
'(7 8 9 10 13 14 15 16 19 20 21 22 25 26 27 28)
:initial-value (if (eq turn 'b) 0 1)))
関数 board-to-key は盤面と手番を整数値に変換します。キーは 17 桁の 3 進数として考えて、最上位の桁が手番 (0: 先手, 1: 後手) で、残りの 16 桁で盤面 (0: 空き場所、1: 白石、2: 黒石) を表します。
ネガマックス法に置換表を適用する場合、メモ化関数として実装すると簡単です。メモ化関数については、拙作のページ「メモ化と遅延評価」をお読みください。プログラムは次のようになります。
リスト : メモ化関数
(defun memoize (func)
(let ((table (make-hash-table)))
(lambda (turn ls pass)
(if (or (null ls) (null (cdr ls)))
(funcall func turn ls pass)
(let* ((key (board-to-key turn))
(val (gethash key table)))
(cond
(val
(incf *hits*)
(values (car val) (cadr val)))
(t
(multiple-value-bind
(value move)
(funcall func turn ls pass)
;; 置換表にセット
(setf (gethash key table) (list value move))
(values value move)))))))))
関数 memoize は引数の関数 FUNC をメモ化します。キーは整数値なので、関数 make-hash-table のキーワード引数 :test はデフォルト (eql) のままでかまいません。スペシャル変数 *HITS* は置換表にヒットした回数を格納します。
ミニミニリバーシの場合、局面の評価値は簡単に求めることができますが、キーの生成には少々時間がかかります。このため、すべての局面を置換表に登録すると、かえって実行時間が遅くなるのです。また、ゲーム木が大きくなると、生成される局面は膨大な数になるので、すべての局面を置換表に登録するのは現実的ではありません。ミニミニリバーシの場合、空き場所がひとつ以下の局面は置換表に登録しないことにします。
空き場所が 2 つ以上ある場合、board-to-key でキーを生成して、置換表 TABLE を検索します。評価値と指し手が登録されている場合、それを values で返します。このとき、*HITS* を +1 します。登録されていない場合は FUNC を呼び出して、評価値 VALUE と指し手 MOVE を求め、それを置換表 TABLE に格納します。最後に VALUE と MOVE を返します。
それから、関数 nega-max を実行する前に、memoize でメモ化することを忘れないでください。
リスト : 関数 nega-max のメモ化 (setf (symbol-function 'nega-max) (memoize #'nega-max))
なお、関数 nega-max は修正しなくても大丈夫です。
それでは実行結果を示します。勝敗はネガマックス法とまったく同じです。置換表の効果を確かめるため、局面を評価した回数をカウントして比較してみましょう。置換表が有効に機能すれば、局面の評価回数は少なくなるはずです。結果は次のようになりました。
表 : 局面の評価回数
| W B | W B
初期値| B W | W B
-------+-------+-------
negamax| 60060 | 67116
時間 | 0.27s | 0.32s
-------+-------+-------
メモ化 | 22022 | 23048
ヒット | 10690 | 10408
時間 | 0.20s | 0.24s
実行環境 : Ubunts 18.04 (Windows Subsystem for Linux), Intel Core i5-6200U 2.30GHz
置換表を適用したことにより局面の評価回数は減少し、それだけ実行時間も速くなりました。ミニミニリバーシの場合、置換表の効果は大きいようです。
次は 4 行 6 列盤のアルファベータ法 (ネガアルファ法) に置換表を適用してみましょう。アルファベータ法の場合、枝刈り (αカット、βカット) が行われると、局面の評価値はミニマックス法で求められる正確な値にはなりません。この正確な値を minimax 値と呼ぶことにします。
たとえば window の幅を (α, β) とすると、null window search と同様にα値以下であれば fail-low になり、β値以上であれば fail-high になります。このため、置換表に評価値だけを格納しても、それが minimax 値なのか、それとも fail-low または fail-high なのか判断することができません。
そこで、置換表には minimax 値が存在する範囲 (lower, upper) を格納することにします。lower と upper は下限値と上限値を表し、MIN-VALUE と MAX-VALUE で初期化しておきます。そして、求めた評価値 value が fail-low であれば、minimax 値は value 以下であることがわかるので、置換表のデータを (lower, value) に書き換えます。
逆に、value が fail-high であれば、minimax 値は value 以上であることがわかるので、置換表のデータを (value, upper) に書き換えます。もしも、value が (α, β) の範囲内にあれば、それは minimax 値なので、置換表のデータを (value, value) に書き換えます。これで、minimax 値と fail-low, fail-high を区別することができます。
そして、置換表の範囲 (lower, upper) と window の幅 (α, β) を比較して、置換表の情報を採用するか否かを決定します。これは次に示す 3 通りの場合があります。
(1) β <= lower (2) upper <= α (3) upper == lower
(1) の場合、minimax 値はβ値以上にあることが確定するので、ここで枝刈りすることができます。この場合は評価値として lower を返します。(2) の場合、minimax 値はα値以下であることが確定します。つまり、fail-low になるので、この局面は選択されません。この場合、評価値として upper を返します。最後に (3) の場合は minimax 値なので、その値 (lower or upper) を返します。
これ以外の場合は、置換表の情報は採用しないで実際に探索を行います。このとき、(lower, upper) と (α, β) を比較して、window の幅が狭くなるように設定してから、ゲーム木を探索します。そして、その結果を使って置換表の情報を更新します。このように、アルファベータ法の場合はミニマックス法よりも処理が複雑になります。
プログラムは次のようになります。
リスト : メモ化関数
(defun memoize-ab (func)
(let ((table (make-hash-table)))
(lambda (turn ls pass alpha beta)
(if (or (null ls) (null (cdr ls)))
(funcall func turn ls pass alpha beta)
(let* ((key (board-to-key turn))
(val (gethash key table))
(lower (if val (car val) MIN-VALUE))
(upper (if val (cadr val) MAX-VALUE))
(value nil)
(move (if val (caddr val) nil)))
(cond
((and val (>= lower beta))
(incf *hits*)
(setq value lower))
((and val (or (<= upper alpha) (= upper lower)))
(incf *hits*)
(setq value upper))
(t
(setq alpha (max alpha lower))
(setq beta (min beta upper))
(multiple-value-setq
(value move)
(funcall func turn ls pass alpha beta))))
;; 置換表の更新
(setf (gethash key table)
(cond
((<= value alpha) (list lower value move))
((>= value beta) (list value upper move))
(t (list value value move))))
;; 値と指し手を返す
(values value move))))))
空き場所が 2 つ以上ある場合、置換表からデータ LOWER, UPPER, MOVE を取り出します。MOVE は指し手になります。置換表にデータがない場合、変数 LOWER を MIN-VALUE に、UPPER を MAX-VALUE に初期化します。
LOWER >= BETA の場合、枝刈りできるので LOWER と MOVE を返します。UPPER >= ALPHA の場合、fail-low になるので UPPER と MOVE を返します。また、LOWER と UPPER が等しい場合、それは minimax 値なので UPPER と MOVE を返します。それ以外の場合、ALPHA と LOWER を比較して、大きいほうを ALPHA にセットします。BETA と UPPER の場合は、小さいほうを BETA にセットします。たとえば、LOWER < ALPHA < UPPER < BETA であれば、window の幅は (ALPHA, UPPER) になります。これで、window の幅を狭くしてゲーム木を探索することができます。
ゲーム木の探索が終わったら、置換表のデータを更新します。評価値 VALUE が ALPHA 以下の場合は fail-low なので、minimax 値は VALUE 以下であることがわかります。置換表の上限値を VALUE に書き換えます。初出の局面の場合、LOWER は MIN-VALUE に初期化されているので、(MIN-VALUE, VALUE) が minimax 値の範囲になります。
VALUE が BETA 以上であれば fail-high なので、置換表の下限値を VALUE に書き換えます。初出の局面の場合、UPPER は MAX-VALUE に初期化されているので、(VALUE, MAX-VALUE) が minimax 値の範囲になります。それ以外の場合、VALUE は minimax 値になるので、上限値と下限値を VALUE に書き換えます。
最後に、関数 nega-alpha2 と nega-scout に memoize-ab を適用してメモ化します。
リスト : メモ化 (setf (symbol-function 'nega-alpha2) (memoize-ab #'nega-alpha2)) (setf (symbol-function 'nega-scout) (memoize-ab #'nega-scout))
これで nega-scout にも置換表を適用することができます。あとは特に難しいところはないので、説明は割愛いたします。詳細はプログラムリスト２をお読みください。
それでは実行結果を示します。勝敗はネガアルファ法とまったく同じです。置換表の効果を確かめるため、局面を評価した回数をカウントして比較してみましょう。置換表が有効に機能すれば、局面の評価回数は少なくなるはずです。結果は次のようになりました。
表 : 局面の評価回数
| W B | W B
初期値| B W | W B
-------+---------+---------
ab | 211710 | 513340
時間 | 1.32 s | 3.11 s
-------+---------+---------
メモ化 | 83049 | 127718
ヒット | 38486 | 77725
時間 | 1.03 s | 1.61 s
| W B | W B
初期値| B W | W B
-------+---------+---------
scout | 173668 | 496740
時間 | 1.18 s | 3.18 s
-------+---------+---------
メモ化 | 55002 | 94923
ヒット | 26265 | 56371
時間 | 0.74 s | 1.19 s
ネガアルファ法もネガスカウト法も置換表の効果により、局面の評価回数は減少して実行時間も速くなりました。ネガスカウト法の場合、null window search を行っている分だけ、置換表の効果は他の方法よりも大きくなるようです。置換表の効果は十分に出ていると思います。
次は MTD(f) 法を説明します。MTD は "Memory Test Drive" の略で、探索した局面の情報をメモリに保存しておいて、null window search を繰り返し適用することで minimax 値が存在する範囲を絞っていく手法です。局面の情報は置換表を使って保存します。MTD(f) 法は null window search で window の値を変えながらゲーム木を何度も探索するので、置換表がないと高速に動作しません。置換表が必須のアルゴリズムなのです。
それでは、プログラムを作りましょう。MTD(f) 法はアルファベータ法と置換表で作成したプログラムを使うと、とても簡単にプログラムすることができます。次のリストを見てください。
リスト : MTD(f) 法
(defun mtd-f (f)
(let ((lower MIN-VALUE)
(upper MAX-VALUE)
(bound f)
(value nil)
(move nil))
(loop
(multiple-value-setq
(value move)
(nega-alpha2 'b space-list nil (1- bound) bound))
(if (< value bound)
(setq upper value)
(setq lower value))
(setq bound (if (= lower value) (+ value 1) value))
(unless (< lower upper)
(return (values value move))))))
関数 mtd-f の引数 F は "first guess" の意味で、null window search を行うときの window の初期値です。F が minimax 値に近いほど MTD(f) 法の探索効率は良くなります。F の設定が MTD(f) 法を使いこなすポイントの一つになります。
変数 LOWER と UPPER は minimax 値が存在する範囲を表します。LOWER が下限値で MIN-VALUE に初期化し、UPPER が上限値で MAX-VALUE に初期化します。BOUND は null window search での window の値で F に初期化します。
あとは loop で null window search を繰り返し実行します。nega-alpha2 は memoize-ab でメモ化した関数です。window の幅を (bound - 1, bound) に設定して呼び出すと、null window search になります。置換表がないと MTD(f) 法は高速に動作しません。ご注意ください。
返り値 VALUE が BOUND よりも小さい場合は fail-low なので、minimax 値は VALUE 以下であることがわかります。UPPER を書き換えて範囲を (LOWER, VALUE) に設定します。そうでなければ fail-high なので、minimax 値は VALUE 以上であることがわかります。LOWER を VALUE に書き換えて、範囲を (VALUE, UPPER) に設定します。
それから、BOUND の値を更新します。VALUE が下限値 (LOWER) の場合、次の null window search は (VALUE, VALUE + 1) で行うので、BOUND を VALUE + 1 に設定します。VALUE が上限値 (UPPER) の場合は、(VALUE - 1, VALUE) で null window search を行うので、BOUND を VALUE に設定します。null window serach を繰り返すたびに (LOWER, UPPER) の範囲が絞られていき、最後は LOWER >= UPPER になります。ここで、繰り返しを終了して value, move を返します。
それでは実行結果を示します。勝敗は今までの方法とまったく同じです。局面の評価回数と置換表にヒットした回数は次のようになりました。
表 : 局面の評価回数 (f = 0)
| W B | W B
初期値| B W | W B
-------+--------+--------
MTD(f) | 52527 | 77077
ヒット | 28498 | 44329
時間 | 0.95 s | 1.17 s
表 : 局面の評価回数 (f = 16, 18)
| W B | W B
初期値| B W | W B
-------+--------+--------
MTD(f) | 44565 | 66338
ヒット | 20040 | 34559
時間 | 0.70 s | 0.84 s
MTD(f) 法の場合、局面の評価回数はネガアルファ法とネガスカウト法よりも少なくなり、実行時間も速くなりました。これは置換表の効果だけではなく、null window search を繰り返し適用する MTD(f) 法の効果が出ていると思われます。MTD(f) 法は優秀なアルゴリズムだと思います。興味のある方はいろいろ試してみてください。
;;;
;;; rev24c.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 b w 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*) ; 評価回数
(defvar *hits*) ; 置換表のヒット数
;;; アクセス関数
(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)))))
;;;
;;; ネガアルファ法 (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 nega-scout (turn xs pass alpha beta)
(if (null xs)
(values (get-value turn) nil) ; ゲーム終了 (空き場所なし)
(let ((value min-value) move)
(dolist (x xs)
(let ((a (max alpha value))
(rs (get-rev-stone x turn)))
(when rs
(reverse-stone rs turn)
(put-piece x turn)
;; null window search
(multiple-value-bind
(v m)
(nega-scout (change-turn turn) (remove x xs) nil (- (1+ a)) (- a))
(setq v (- v))
(when (> beta v a)
;; 再度探索する
(multiple-value-bind
(v1 m1)
(nega-scout (change-turn turn) (remove x xs) nil (- beta) (- v))
(setq v (- v1) m m1)))
(del-piece x)
(reverse-stone rs (change-turn turn))
;; ミニマックス法
(when (< value v)
;; アルファベータ法
(when (<= beta v)
(return-from nega-scout (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-scout (change-turn turn) xs t (- beta) (- alpha))
(values (- v) (cons 'pass m))))
(values value move)))))
;;;
;;; 置換表
;;;
;;; 盤面を数値に変換する
(defun board-to-key (turn)
(reduce
(lambda (a x)
(case
(get-piece x)
(b (+ (* a 3) 2))
(w (+ (* a 3) 1))
(otherwise (* a 3))))
'( 9 10 11 12 13 14 17 18 19 20 21 22
25 26 27 28 29 30 33 34 35 36 37 38)
:initial-value (if (eq turn 'b) 0 1)))
;;; メモ化
(defun memoize-ab (func)
(let ((table (make-hash-table)))
(lambda (turn ls pass alpha beta)
(if (or (null ls) (null (cdr ls)))
(funcall func turn ls pass alpha beta)
(let* ((key (board-to-key turn))
(val (gethash key table))
(lower (if val (car val) MIN-VALUE))
(upper (if val (cadr val) MAX-VALUE))
(value nil)
(move (if val (caddr val) nil)))
(cond
((and val (>= lower beta))
(incf *hits*)
(setq value lower))
((and val (or (<= upper alpha) (= upper lower)))
(incf *hits*)
(setq value upper))
(t
(setq alpha (max alpha lower))
(setq beta (min beta upper))
(multiple-value-setq
(value move)
(funcall func turn ls pass alpha beta))))
;; 置換表の更新
(setf (gethash key table)
(cond
((<= value alpha) (list lower value move))
((>= value beta) (list value upper move))
(t (list value value move))))
;; 値と指し手を返す
(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)))))
;;; メモ化
(setf (symbol-function 'nega-alpha2) (memoize-ab #'nega-alpha2))
(setf (symbol-function 'nega-scout) (memoize-ab #'nega-scout))
;;; MTD(f) 法
(defun mtd-f (f)
(let ((lower MIN-VALUE)
(upper MAX-VALUE)
(bound f)
(value nil)
(move nil))
(loop
(multiple-value-setq
(value move)
(nega-alpha2 'b space-list nil (1- bound) bound))
(if (< value bound)
(setq upper value)
(setq lower value))
(setq bound (if (= lower value) (+ value 1) value))
(unless (< lower upper)
(return (values value move))))))
;;; 解法
(defun solver ()
(setq *board* (make-array (length init-board) :initial-contents init-board)
*white* 2
*black* 2
*hits* 0
*count* 0)
(multiple-value-bind
(v m)
;;(nega-alpha2 'b space-list nil min-value max-value)
;;(nega-scout 'b space-list nil min-value max-value)
(mtd-f 0)
(format t "value = ~d~%" v)
(print m)
(print *count*)
(print *hits*)))