置換表と MTD(f) 法
前回の続きです。今回は「置換表 (transposition table)」と「MTD(f) 法」を取り上げます。題材とするゲームは前回と同じく「ミニミニリバーシ変形版」です。
●置換表とは？
置換表は局面の情報を格納しておく表 (table) のことです。ゲーム木の探索では、同じ局面が何度も現れることがよくあります。同じ局面を何度も探索するのは時間の無駄なので、すでに探索した局面はその情報 (評価値、手番、探索の深さなど) を表に格納しておき、同一局面が現れたら表の情報を再利用します。表の情報が十分なものであれば、そこで探索を打ち切って、評価値をそのまま返すことができます。もし、情報が不十分な場合でも、それを基にして探索を続行し、その結果で表の情報を更新します。
一般に、何度も同じ値を計算することがないように、計算した値は表に格納しておいて、2 回目以降は表から計算結果を求めることでプログラムを高速化する手法を「表計算法」といいます。表を使うアルゴリズムというと、有名なところでは「動的計画法」があります。置換表は表計算法の一種と考えることができます。置換表はチェス、将棋、リバーシなどのプログラムでよく用いられる手法です。置換表は ハッシュ法 を使って実装するのが一般的です。今回は拙作のライブラリ (mylib hash) を使って置換表をプログラムしてみましょう。
●ネガマックス法と置換表
まずは最初にミニミニリバーシ (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 の評価値を返しても問題ありません。また、同じレベルの局面の場合も置換表の評価値をそのまま利用することができます。
このように、探索の深さにより置換表の情報を採用するか否かを決定することができます。ただし、今回のミニミニリバーシのようにゲーム終了まで読み切る場合、探索の深さを考慮する必要はありません。手番と局面からキーを生成して、評価値と指し手を置換表に登録することにします。
●プログラムの作成
最初に手番と盤面からキーを生成する関数を作ります。
リスト : キーの生成
;;; 置換表のヒット回数
(define *hits* 0)
;;; 盤面からキーとなる数値を作る
(define (board->key turn)
(foldl
(lambda (a x)
(case (get-piece x)
((B) (+ (* a 3) 2))
((W) (+ (* a 3) 1))
(else (* a 3))))
(if (eq? turn 'B) 0 1)
'(7 8 9 10 13 14 15 16 19 20 21 22 25 26 27 28)))
関数 board->key は盤面と手番を整数値に変換します。キーは 17 桁の 3 進数として考えて、最上位の桁が手番 (0: 先手, 1: 後手) で、残りの 16 桁で盤面 (0: 空き場所、1: 白石、2: 黒石) を表します。*hits* は置換表にヒットした回数を格納します。
ネガマックス法に置換表を適用する場合、メモ化関数として実装すると簡単です。メモ化関数については、拙作のページ メモ化と遅延評価 をお読みください。プログラムは次のようになります。
リスト : メモ化関数
(define (memoize func)
(let ((table (make-hash-table 49999 board->key eqv?)))
(lambda (turn ls pass)
(if (or (null? ls) (null? (cdr ls)))
(func turn ls pass)
(let* ((key (board->key turn))
(val (hash-find table key)))
(cond
(val
(set! *hits* (+ *hits* 1))
(values (car val) (cadr val)))
(else
(let-values (((value move) (func turn ls pass)))
;; 置換表にセット
(hash-set! table key (list value move))
(values value move)))))))))
関数 memoize は引数の関数 func をメモ化します。キーは整数値なので、関数 make-hash-table の引数には eqv? を指定します。
ミニミニリバーシの場合、局面の評価値は簡単に求めることができますが、キーの生成には少々時間がかかります。このため、すべての局面を置換表に登録すると、かえって実行時間が遅くなるのです。また、ゲーム木が大きくなると、生成される局面は膨大な数になるので、すべての局面を置換表に登録するのは現実的ではありません。ミニミニリバーシの場合、空き場所がひとつ以下の局面は置換表に登録しないことにします。
空き場所が 2 つ以上ある場合、board->key でキーを生成して、置換表 table を検索します。評価値と指し手が登録されている場合、それを values で返します。このとき、*hits* を +1 します。登録されていない場合は func を呼び出して、評価値 value と指し手 move を求め、それを置換表 table に格納します。最後に value と move を返します。
それから、関数 nega-max を実行する前に、memoize でメモ化することを忘れないでください。
リスト : 関数 nega-max のメモ化 (set! nega-max (memoize nega-max))
なお、関数 nega-max は修正しなくても大丈夫です。あとは特に難しいところはないと思います。説明は割愛いたしますので、詳細は プログラムリスト１ をお読みください。
●実行結果
それでは実行結果を示します。勝敗はネガマックス法とまったく同じです。置換表の効果を確かめるため、局面を評価した回数をカウントして比較してみましょう。置換表が有効に機能すれば、局面の評価回数は少なくなるはずです。結果は次のようになりました。
表 : 局面の評価回数
| W B | W B
初期値| B W | W B
-------+-------+-------
negamax| 60060 | 67116
時間 | 1.4 s | 1.6 s
-------+-------+-------
メモ化 | 22022 | 23048
ヒット | 10690 | 10408
時間 | 1.2 s | 1.2 s
実行環境 : Gauche 0.9.9, Ubunts 18.04 (WSL), Intel Core i5-6200U 2.30GHz
置換表を適用したことにより局面の評価回数は減少し、実行時間も少し速くなりました。ミニミニリバーシの場合、置換表の効果は十分にあると思います。
●アルファベータ法と置換表
次は「ミニミニリバーシ変形版」のアルファベータ法 (ネガアルファ法) に置換表を適用してみましょう。アルファベータ法の場合、枝刈り (αカット、βカット) が行われると、局面の評価値はミニマックス法で求められる正確な値にはなりません。この正確な値を 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 の幅が狭くなるように設定してから、ゲーム木を探索します。そして、その結果を使って置換表の情報を更新します。このように、アルファベータ法の場合はミニマックス法よりも処理が複雑になります。
プログラムは次のようになります。
リスト : メモ化関数
(define (memoize func)
(let ((table (make-hash-table 99991 board->key eqv?)))
(lambda (turn ls pass alpha beta)
(if (null? (drop ls 4)) ; (mylib list) の drop を使うこと
(func turn ls pass alpha beta)
(let* ((key (board->key turn))
(val (hash-find table key))
(lower (if val (car val) MIN-VALUE))
(upper (if val (cadr val) MAX-VALUE))
(value #f)
(move (if val (caddr val) #f)))
(cond
((and val (>= lower beta))
(set! *hits* (+ *hits* 1))
(set! value lower))
((and val (or (<= upper alpha) (= upper lower)))
(set! *hits* (+ *hits* 1))
(set! value upper))
(else
(set! alpha (max alpha lower))
(set! beta (min beta upper))
(let-values (((value1 move1)
(func turn ls pass alpha beta)))
(set! value value1)
(set! move move1))))
;; 置換表の更新
(hash-set!
table
key
(cond
((<= value alpha) (list lower value move))
((>= value beta) (list value upper move))
(else (list value value move))))
;; 値と指し手を返す
(values value move))))))
ミニミニリバーシ変形版の場合、空き場所が 4 つ以下の局面は置換表に登録しないことにします。空き場所が 5 つ以上ある場合、置換表からデータ 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-alpha と nega-scout に memoize を適用してメモ化します。関数 nega-alpha は前々回作成したネガアルファ法 fail-soft 対応版 (nega-alpha2) と同じで、関数 nega-scout は前回作成したプログラムと同じです。修正する必要はありません。
リスト : メモ化 (set! nega-alpha (memoize nega-alpha)) (set! nega-scout (memoize nega-scout))
これで nega-scout にも置換表を適用することができます。あとは特に難しいところはないので、説明は割愛いたします。詳細は プログラムリスト２ をお読みください。
●実行結果 (2)
それでは実行結果を示します。勝敗はネガアルファ法とまったく同じです。置換表の効果を確かめるため、局面を評価した回数をカウントして比較してみましょう。置換表が有効に機能すれば、局面の評価回数は少なくなるはずです。結果は次のようになりました。
表 : 局面の評価回数
| W B | W B
初期値| B W | W B
-------+---------+---------
ab法 | 1690895 | 898585
時間 | 54.0 s | 25.6 s
-------+---------+---------
メモ化 | 924065 | 551341
ヒット | 29177 | 17610
時間 | 39.2 s | 21.2 s
表 : 局面の評価回数
| W B | W B
初期値| B W | W B
-------+---------+---------
scout | 1309977 | 524627
時間 | 41.8 s | 15.6 s
-------+---------+---------
メモ化 | 691090 | 270972
ヒット | 24737 | 9706
時間 | 32.0 s | 11.3 s
ネガアルファ法もネガスカウト法も置換表の効果により、局面の評価回数は減少して実行時間も速くなりました。置換表の効果は十分に出ていると思います。
●MTD(f) 法
次は MTD(f) 法を説明します。MTD は "Memory Test Drive" の略で、探索した局面の情報をメモリに保存しておいて、null window search を繰り返し適用することで minimax 値が存在する範囲を絞っていく手法です。局面の情報は置換表を使って保存します。MTD(f) 法は null window search で window の値を変えながらゲーム木を何度も探索するので、置換表がないと高速に動作しません。置換表が必須のアルゴリズムなのです。
それでは、プログラムを作りましょう。MTD(f) 法はアルファベータ法と置換表で作成したプログラムを使うと、とても簡単にプログラムすることができます。次のリストを見てください。
リスト : MTD(f) 法
(define (mtd-f f)
(let ((lower MIN-VALUE)
(upper MAX-VALUE)
(bound f)
(value #f)
(move #f))
(let loop ()
(let-values (((value1 move1)
(nega-alpha 'B
'(11 12 25 30 33 38 51 52 18 21
42 45 19 20 26 29 34 37 43 44)
#f
(- bound 1)
bound)))
(set! value value1)
(set! move move1))
(if (< value bound)
(set! upper value)
(set! lower value))
(set! bound (if (= lower value) (+ value 1) value))
(if (< lower upper)
(loop)
(values value move)))))
関数 mtdf の引数 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 に初期化します。
あとは name-let で null window search を繰り返します。nega-alpha は memoize でメモ化した関数です。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 を返します。
●実行結果 (3)
それでは実行結果を示します。勝敗は今までの方法とまったく同じです。局面の評価回数と置換表にヒットした回数は次のようになりました。
表 : 局面の評価回数
| W B | W B
初期値| B W | W B
-------+--------+--------
MTD(f) | 577479 | 252897
ヒット | 19048 | 10700
時間 | 26.0 s | 11.3 s
MTD(f) 法の場合、局面の評価回数はネガアルファ法とネガスカウト法よりも少なくなり、実行時間も少し速くなりました。これは置換表の効果だけではなく、null window search を繰り返し適用する MTD(f) 法の効果が出ていると思われます。MTD(f) 法は優秀なアルゴリズムだと思います。興味のある方はいろいろ試してみてください。
●プログラムリスト１
;;;
;;; rev16c.scm : 4 * 4 リバーシ (置換表)
;;;
;;; Copyright (C) 2010-2020 Makoto Hiroi
;;;
(import (scheme base) (scheme write)
(mylib list) ; プログラムリスト を参照
(mylib hash)) ; プログラムリスト を参照
;;; 定数
(define MIN-VALUE -50)
(define MAX-VALUE 50)
;;; 方向
(define *direction* '(1 -1 6 -6 7 -7 5 -5))
;;; 初期値
(define *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))
;;; 盤面
(define *board* (list->vector *init-board*))
;;; 石の個数
(define *black* 2)
(define *white* 2)
;;; 評価回数
(define *count* 0)
;;; 置換表のヒット回数
(define *hits* 0)
;;; アクセス関数
(define (get-piece x) (vector-ref *board* x))
(define (put-piece! x p)
(if (eq? p 'B)
(set! *black* (+ *black* 1))
(set! *white* (+ *white* 1)))
(vector-set! *board* x p))
(define (del-piece! x)
(if (eq? (get-piece x) 'B)
(set! *black* (- *black* 1))
(set! *white* (- *white* 1)))
(vector-set! *board* x 'S))
;;; 盤面からキーとなる数値を作る
(define (board->key turn)
(foldl
(lambda (a x)
(case (get-piece x)
((B) (+ (* a 3) 2))
((W) (+ (* a 3) 1))
(else (* a 3))))
(if (eq? turn 'B) 0 1)
'(7 8 9 10 13 14 15 16 19 20 21 22 25 26 27 28)))
;;; 反転できる石に対して畳み込みを行う
(define (fold-direction func x p1 a dir)
(let loop ((x (+ x dir)) (b a))
(let ((p (get-piece x)))
(cond ((or (eq? p 'S) (eq? p 'O))
a) ; 反転できず
((eq? p p1) b) ; 反転した
(else
(loop (+ x dir) (func x b)))))))
;;; 反転する石を求める
(define (get-reverse-stone x p)
(foldl (lambda (a dir)
(fold-direction cons x p a dir))
'()
*direction*))
;;; 評価値
(define (get-value)
(set! *count* (+ *count* 1))
(- *black* *white*))
;;; 石を反転する
(define (reverse-stone ls p)
(for-each (lambda (x) (put-piece! x p)) ls)
(if (eq? p 'B)
(set! *white* (- *white* (length ls)))
(set! *black* (- *black* (length ls)))))
;;; 手番の交代
(define (change-turn turn)
(if (eq? turn 'B) 'W 'B))
;;; ネガマックス法
(define (nega-max turn ls pass)
(if (null? ls)
(values (if (eq? turn 'B) (get-value) (- (get-value)))
'())
(let loop ((xs ls) (move #f) (value MIN-VALUE))
(if (null? xs)
(if (not move)
;; パス
(if pass
;; 白黒ともにパス
(values (if (eq? turn 'B) (get-value) (- (get-value)))
(list 'pass))
;; 手番を移す
(let-values (((v m) (nega-max (change-turn turn) ls #t)))
(values (- v) (cons 'pass m))))
;; 評価値と指し手を返す
(values value move))
(let* ((v #f)
(m #f)
(x (car xs))
(r (get-reverse-stone x turn)))
(when
(pair? r)
(reverse-stone r turn)
(put-piece! x turn)
;; 手番を移す
(let-values (((v1 m1) (nega-max (change-turn turn) (remove x ls) #f)))
(set! v (- v1))
(set! m m1))
;; 元に戻す
(reverse-stone r (change-turn turn))
(del-piece! x))
;; ミニマックス法
(if (and v (> v value))
(loop (cdr xs) (cons x m) v)
(loop (cdr xs) move value)))))))
;;; メモ化関数
(define (memoize func)
(let ((table (make-hash-table 49999 board->key eqv?)))
(lambda (turn ls pass)
(if (or (null? ls) (null? (cdr ls)))
(func turn ls pass)
(let* ((key (board->key turn))
(val (hash-find table key)))
(cond
(val
(set! *hits* (+ *hits* 1))
(values (car val) (cadr val)))
(else
(let-values (((value move) (func turn ls pass)))
;; 置換表にセット
(hash-set! table key (list value move))
(values value move)))))))))
;;; 盤面の表示
(define (print-board)
(do ((i 0)
(x 0 (+ x 1)))
((>= x (vector-length *board*)) (newline))
(unless
(eq? (get-piece x) 'O)
(display (get-piece x))
(display " ")
(set! i (+ i 1))
(when
(= i 4)
(newline)
(set! i 0)))))
;;; 手順の表示
(define (print-move ls)
(let ((turn 'B))
(for-each
(lambda (x)
(cond
((eq? x 'pass)
(display turn)
(display " : PASS!!\n"))
(else
(display turn) (display " : ") (display x) (newline)
(reverse-stone (get-reverse-stone x turn) turn)
(put-piece! x turn)
(display "B = ") (display *black*)
(display " : W = ") (display *white*) (newline)
(print-board)))
(set! turn (if (eq? turn 'B) 'W 'B)))
ls)))
;;; 実行
(set! nega-max (memoize nega-max))
(let-values (((v m)
(nega-max 'B '(7 10 25 28 8 9 13 16 19 22 26 27) #f)))
(display v) (newline)
(display m) (newline)
; (print-move m)
(display *count*) (newline)
(display *hits*) (newline))
●プログラムリスト２
;;;
;;; rev24a.scm : 変形版リバーシ (置換表)
;;;
;;; Copyright (C) 2010-2020 Makoto Hiroi
;;;
(import (scheme base) (scheme write) (scheme cxr)
(mylib list) ; プログラムリスト を参照
(mylib hash)) ; プログラムリスト を参照
;;; 定数
(define MIN-VALUE -50)
(define MAX-VALUE 50)
;;; 方向
(define *direction* '(1 -1 8 -8 9 -9 7 -7))
;;; 初期値
(define *init-board*
'(O O O O O O O O
O O O S S O O O ; 11 12
O O S S S S O O ; 18 19 20 21
O S S W B S S O ; 25 26 27 28 29 30
O S S B W S S O ; 33 34 35 36 37 38
O O S S S S O O ; 42 43 44 45
O O O S S O O O ; 51 52
O O O O O O O O))
;;; 盤面
(define *board* (list->vector *init-board*))
;;; 石の個数
(define *black* 2)
(define *white* 2)
;;; 評価回数
(define *count* 0)
;;; アクセス関数
(define (get-piece x) (vector-ref *board* x))
(define (put-piece! x p)
(if (eq? p 'B)
(set! *black* (+ *black* 1))
(set! *white* (+ *white* 1)))
(vector-set! *board* x p))
(define (del-piece! x)
(if (eq? (get-piece x) 'B)
(set! *black* (- *black* 1))
(set! *white* (- *white* 1)))
(vector-set! *board* x 'S))
;;; 反転できる石に対して畳み込みを行う
(define (fold-direction func x p1 a dir)
(let loop ((x (+ x dir)) (b a))
(let ((p (get-piece x)))
(cond ((or (eq? p 'S) (eq? p 'O))
a) ; 反転できず
((eq? p p1) b) ; 反転した
(else
(loop (+ x dir) (func x b)))))))
;;; 反転する石を求める
(define (get-reverse-stone x p)
(foldl (lambda (a dir)
(fold-direction cons x p a dir))
'()
*direction*))
;;; 評価値
(define (get-value)
(set! *count* (+ *count* 1))
(- *black* *white*))
;;; 石を反転する
(define (reverse-stone ls p)
(for-each (lambda (x) (put-piece! x p)) ls)
(if (eq? p 'B)
(set! *white* (- *white* (length ls)))
(set! *black* (- *black* (length ls)))))
;;; 手番の交代
(define (change-turn turn)
(if (eq? turn 'B) 'W 'B))
;;; ネガアルファ法改良版 (fail-soft 対応)
(define (nega-alpha turn ls pass alpha beta)
(if (null? ls)
(values (if (eq? turn 'B) (get-value) (- (get-value)))
'())
(let loop ((xs ls) (move #f) (value MIN-VALUE))
(if (null? xs)
(if (not move)
;; パス
(if pass
;; 白黒ともにパス
(values (if (eq? turn 'B) (get-value) (- (get-value)))
(list 'pass))
;; 手番を移す
(let-values (((v m)
(nega-alpha (change-turn turn) ls #t (- beta) (- alpha))))
(values (- v) (cons 'pass m))))
;; 評価値と指し手を返す
(values value move))
(let* ((v #f)
(m #f)
(x (car xs))
(r (get-reverse-stone x turn)))
(when
(pair? r)
(reverse-stone r turn)
(put-piece! x turn)
;; 手番を移す
(let-values (((v1 m1)
(nega-alpha (change-turn turn)
(remove x ls)
#f
(- beta)
(- (max alpha value)))))
(set! v (- v1))
(set! m m1))
;; 元に戻す
(reverse-stone r (change-turn turn))
(del-piece! x))
;; ミニマックス法
(if (and v (> v value))
;; アルファベータ法
(if (>= v beta)
(values v (cons x m))
(loop (cdr xs) (cons x m) v))
(loop (cdr xs) move value)))))))
;;; ネガスカウト法
(define (nega-scout turn ls pass alpha beta)
(if (null? ls)
(values (if (eq? turn 'B) (get-value) (- (get-value)))
'())
(let loop ((xs ls) (move #f) (value MIN-VALUE))
(if (null? xs)
(if (not move)
;; パス
(if pass
;; 白黒ともにパス
(values (if (eq? turn 'B) (get-value) (- (get-value)))
(list 'pass))
;; 手番を移す
(let-values (((v m)
(nega-scout (change-turn turn) ls #t (- beta) (- alpha))))
(values (- v) (cons 'pass m))))
;; 評価値と指し手を返す
(values value move))
(let* ((v #f)
(m #f)
(a (max alpha value))
(x (car xs))
(r (get-reverse-stone x turn)))
(when
(pair? r)
(reverse-stone r turn)
(put-piece! x turn)
;; null window search
(let-values
(((v1 m1) (nega-scout (change-turn turn)
(remove x ls)
#f
(- (+ a 1))
(- a))))
(set! v (- v1))
(set! m m1))
(when
(> beta v a)
;; 再度探索する
(let-values
(((v1 m1) (nega-scout (change-turn turn)
(remove x ls)
#f
(- beta)
(- v))))
(set! v (- v1))
(set! m m1)))
;; 元に戻す
(reverse-stone r (change-turn turn))
(del-piece! x))
;; ミニマックス
(if (and v (> v value))
;; アルファベータ法
(if (>= v beta)
(values v (cons x m))
(loop (cdr xs) (cons x m) v))
(loop (cdr xs) move value)))))))
;;; 置換表にヒットした回数
(define *hits* 0)
;;; 盤面からキーとなる数値を作る
(define (board->key turn)
(foldl (lambda (a x)
(case (get-piece x)
((B) (+ (* a 3) 2))
((W) (+ (* a 3) 1))
(else (* a 3))))
(if (eq? turn 'B) 0 1)
'(11 12 18 19 20 21 25 26 27 28 29 30
33 34 35 36 37 38 42 43 44 45 51 52)))
;;; メモ化関数
(define (memoize func)
(let ((table (make-hash-table 99991 board->key eqv?)))
(lambda (turn ls pass alpha beta)
(if (null? (drop ls 4))
(func turn ls pass alpha beta)
(let* ((key (board->key turn))
(val (hash-find table key))
(lower (if val (car val) MIN-VALUE))
(upper (if val (cadr val) MAX-VALUE))
(value #f)
(move (if val (caddr val) #f)))
(cond
((and val (>= lower beta))
(set! *hits* (+ *hits* 1))
(set! value lower))
((and val (or (<= upper alpha) (= upper lower)))
(set! *hits* (+ *hits* 1))
(set! value upper))
(else
(set! alpha (max alpha lower))
(set! beta (min beta upper))
(let-values (((value1 move1)
(func turn ls pass alpha beta)))
(set! value value1)
(set! move move1))))
;; 置換表の更新
(hash-set!
table
key
(cond
((<= value alpha) (list lower value move))
((>= value beta) (list value upper move))
(else (list value value move))))
;; 値と指し手を返す
(values value move))))))
;;; MTD(f) 法
(define (mtd-f f)
(let ((lower MIN-VALUE)
(upper MAX-VALUE)
(bound f)
(value #f)
(move #f))
(let loop ()
(let-values (((value1 move1)
(nega-alpha 'B
'(11 12 25 30 33 38 51 52 18 21
42 45 19 20 26 29 34 37 43 44)
#f
(- bound 1)
bound)))
(set! value value1)
(set! move move1))
(if (< value bound)
(set! upper value)
(set! lower value))
(set! bound (if (= lower value) (+ value 1) value))
(if (< lower upper)
(loop)
(values value move)))))
;;; 盤面の表示
(define (print-board)
(do ((i 0)
(x 0 (+ x 1)))
((>= x (vector-length *board*)) (newline))
(if (eq? (get-piece x) 'O)
(display " ")
(display (get-piece x)))
(display " ")
(set! i (+ i 1))
(when
(= i 8)
(newline)
(set! i 0))))
;;; 手順の表示
(define (print-move ls)
(let ((turn 'B))
(for-each
(lambda (x)
(cond
((eq? x 'pass)
(display turn)
(display " : PASS!!\n"))
(else
(display turn) (display " : ") (display x) (newline)
(reverse-stone (get-reverse-stone x turn) turn)
(put-piece! x turn)
(display "B = ") (display *black*)
(display " : W = ") (display *white*) (newline)
(print-board)))
(set! turn (if (eq? turn 'B) 'W 'B)))
ls)))
;;; 実行
(set! nega-scout (memoize nega-scout))
(let-values (((v m)
(nega-scout 'B
'(11 12 25 30 33 38 51 52 18 21
42 45 19 20 26 29 34 37 43 44)
#f
MIN-VALUE
MAX-VALUE)))
(display v) (newline)
(display m) (newline)
;(print-move m)
(display *count*) (newline)
(display *hits*) (newline))
改訂 2020 年 10 月 18 日