アルファベータ法とミニミニリバーシ
今回は「アルファベータ法 (αβ method)」について説明します。難しそうな名前がついていますが、アルファベータ法はミニマックス法を効率化するための枝刈りにすぎません。基本的な探索アルゴリズムを理解していれば、それほど難しい話ではありません。
このアルファベータ法がうまく機能すると、局面を半分以上評価しないで済ますことができるようです。そこで今回は簡単なゲームであるミニミニリバーシ (4 行 4 列盤) の勝敗結果 (先手必勝、後手必勝、引き分け) をミニマックス法で求め、次にアルファベータ法を適用してその効果を確かめてみることにします。
●ミニミニリバーシ
ミニミニリバーシは M.Hiroi が勝手につけた名前で、ようするに 4 行 4 列盤の小さなリバーシのことです。次の図を見てください。
初手で黒石を置くことができる場所は 4 か所あります。黒石をどこに置いても次の手で隅を取られてしまうので、ミニミニリバーシは後手必勝だと思われます。実際にプログラムを作って確かめてみましょう。
●盤面のデータ構造
まず最初に、盤面を表すデータ構造から定義しましょう。盤面はベクタで表します。ベクタの大きさを 16 とすると、石を反転できるか調べるときに、盤面の範囲をチェックする必要があります。このような場合、盤面の外側に壁を設定するとプログラムが簡単になります。下図を見てください。
O O O O O O O : 外側 (範囲外) O S S S S O S : 空き場所 O S W B S O B : 黒石 O S B W S O W : 白石 O S S S S O O O O O O O 図 : 盤面を表すデータ構造
０ １ ２ ３ ４ ５
６ ７ ８ ９ 10 11
12 13 14 15 16 17
18 19 20 21 22 23
24 25 26 27 28 29
30 31 32 33 34 35
図 : ベクタの添字と盤面の対応
盤面を表すベクタの大きさは 36 (6 行 6 列) になります。ベクタの要素はシンボル (O, S, B, W) です。盤面の位置を n とすると、左右の位置は n - 1, n + 1 で、上下の位置は n - 6, n + 6 で、斜めの位置は n - 7, n + 7, n - 5, n + 5 で求めることができます。そして、ベクタの要素が O であれば盤外であることがわかります。
次は大域変数を定義します。
リスト : 大域変数の定義
;;; 定数
(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)
盤面を *board* に、黒石と白石の個数を *black* と *white* に格納します。*count* は局面を評価した回数 (ゲーム終了となる局面の個数) を格納します。
次は盤面にアクセスする関数を定義します。
リスト : アクセス関数
(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))
get-piece は盤面の値を求めます。put-piece! は盤面に石を置きます。このとき、石の個数を +1 します。del-piece! は盤面から石を取り除き、石の個数を -1 します。
●反転する石を求める
次は反転する石を求める関数 get-reverse-stone を作ります。
リスト : 反転する石を求める
;;; 方向
(define *direction* '(1 -1 6 -6 7 -7 5 -5))
;;; 反転できる石に対して畳み込みを行う
(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*))
実際の処理は高階関数 fold-direction で行います。fold-direction は裏返す石に対して畳み込み処理を行います。引数の関数 func には、第 1 引数に裏返す石の位置、第 2 引数に累積変数を渡します。引数 x は置く石の位置、p1 が石の種類、a が累積変数、dir が方向です。
x に dir を加算することで、その方向にある盤面の要素を順番に調べていきます。要素 p が S または O の場合は同じ種類の石で挟めなかったので、引数 a をそのまま返します。p と p1 が同じ種類であれば、その間にある石を裏返すことができるので、累積変数 b に格納した値を返します。それ以外の場合は p1 と異なる石なので、関数 func を適用して、その結果を累積変数 b に格納します。
あとは、get-reverse-stonde で fold-direction を呼び出し、8 方向の結果を関数 foldl でまとめるだけです。foldl は拙作のライブラリ (mylib list) に定義されています。SRFI-1 の fold と同じですが、ラムダ式の引数の順番が異なることに注意してください。fold-direction に cons を渡すことで、反転する石の位置をリストに格納することができます。また cons のかわりに + を渡すと、反転する石の個数を求めることができます。
●ミニマックス法のプログラム
それではミニマックス法のプログラムを作りましょう。先手の指し手を決める関数 think-black は次のようになります。
リスト : ミニマックス法 (先手の手番)
(define (think-black ls pass)
(if (null? ls)
(values (get-value) '())
(let loop ((xs ls) (move #f) (value MIN-VALUE))
(if (null? xs)
(if (not move)
;; パス
(if pass
;; 白黒ともにパス
(values (get-value) (list 'pass))
;; 手番を移す
(let-values (((v m) (think-white ls #t)))
(values v (cons 'pass m))))
;; 評価値と指し手を返す
(values value move))
(let* ((v #f)
(m #f)
(x (car xs))
(r (get-reverse-stone x 'B)))
(when
(pair? r)
(reverse-stone r 'B)
(put-piece! x 'B)
;; 手番を移す
(let-values (((v1 m1) (think-white (remove x ls) #f)))
(set! v v1)
(set! m m1))
;; 元に戻す
(reverse-stone r 'W)
(del-piece! x))
;; ミニマックス法
(if (and v (> v value))
(loop (cdr xs) (cons x m) v)
(loop (cdr xs) move value)))))))
引数 ls は空き場所を格納したリストです。相手がパスしたときは引数 pass に真 (#t) を渡します。think-black は評価値と指し手を格納したリストを返します。ls が空リストの場合はゲーム終了です。評価値は関数 get-value で求めます。評価値は石差 (黒石の数 - 白石の数) で、このとき *count* の値も +1 します。そして values で評価値と空リストを返します。指し手はこの返り値のリストに追加していきます。
指し手は move に、評価値は value に格納します。空き場所をすべて調べたあと、move の値が #f であれば、黒石を置くことができなかったのでパスします。もし引数の pass が真ならば、白石と黒石どちらも置くことができないのでゲームを終了します。values で評価値とリスト (pass) を返します。
そうでなければ、関数 think-white を呼び出して手番を後手に移します。このとき、引数 pass に #t を渡します。その返り値を変数 v と m で受け取り、m に pass を追加してから values で返します。move が真の場合は、values で value と move を返します。
xs に空き場所がある場合、それを取り出して変数 x にセットし、get-reverse-stone で反転する石を求めて変数 r にセットします。pair? で r がリストであることを確認したら、reverse-stone で白石を黒石に反転して、put-piece! で x に黒石を置きます。次に think-white を呼び出して手番を後手に移します。返り値は変数 v と m にセットして、そのあと盤面を元の状態に戻します。
最後に、評価値 v が真で value よりも大きい場合は、指し手 x を選びます。指し手のリスト m に x を追加して、move と value の値を更新します。そうでなければ、move と value の値は更新しません。これでミニマックス法が動作します。
think-white 白石と黒石の処理が逆になるだけで、前回説明したミニマックス法と同じです。あとは特に難しいところは無いので説明は割愛いたします。詳細は プログラムリスト１ をお読みください。
●実行結果
それでは実行結果を示します。
-8 (8 7 13 9 28 19 10 26 25 27 pass pass) B : 8 B = 4 : W = 1 S B S S S B B S S B W S S S S S W : 7 B = 3 : W = 3 W B S S S W B S S B W S S S S S B : 13 B = 5 : W = 2 W B S S B B B S S B W S S S S S W : 9 B = 3 : W = 5 W W W S B B W S S B W S S S S S B : 28 B = 5 : W = 4 W W W S B B W S S B B S S S S B W : 19 B = 3 : W = 7 W W W S W W W S W B B S S S S B B : 10 B = 5 : W = 6 W W W B W W B S W B B S S S S B W : 26 B = 4 : W = 8 W W W B W W B S W W B S S W S B B : 25 B = 6 : W = 7 W W W B W W B S W B B S B W S B W : 27 B = 3 : W = 11 W W W B W W W S W W W S B W W B B : PASS!! W : PASS!! 60060
後手の 8 石勝ちとなりました。局面の評価回数は 60060 回です。アルファベータ法を使うと、もっと少なくすることができます。なお、この他にも白が 8 石勝ちとなる手順は存在します。ミニミニリバーシの場合、初手で黒石をどこにおいても、盤面を回転させれば同じ状態になります。また、初手を限定した場合でも、白が 8 石勝ちとなる手順は複数あるかもしれません。このプログラムは手順のひとつを求めているだけで、それが何通りあるかはわかりません。興味のある方は調べてみてください。
ちなみに、最初の黒石と白石の並びを下図のように変更しても後手必勝となりました。
実行結果を示します。
-3 (7 10 16 22 25 9 28 19 13 pass 27 26 pass pass) B : 7 B = 4 : W = 1 B S S S S B B S S W B S S S S S W : 10 B = 3 : W = 3 B S S W S B W S S W B S S S S S B : 16 B = 5 : W = 2 B S S W S B B B S W B S S S S S W : 22 B = 3 : W = 5 B S S W S B B W S W W W S S S S B : 25 B = 5 : W = 4 B S S W S B B W S B W W B S S S W : 9 B = 4 : W = 6 B S W W S B W W S B W W B S S S B : 28 B = 6 : W = 5 B S W W S B W W S B B W B S S B W : 19 B = 3 : W = 9 B S W W S W W W W W W W B S S B B : 13 B = 5 : W = 8 B S W W B W W W B W W W B S S B W : PASS!! B : 27 B = 7 : W = 7 B S W W B W W W B B W W B S B B W : 26 B = 6 : W = 9 B S W W B W W W B W W W B W B B B : PASS!! W : PASS!! 67116
後手の 3 石勝ちで、局面の評価回数は 67116 回となりました。
●アルファベータ法
次はアルファベータ法を説明します。ミニマックス法の説明では、木を全て探索するので 8 回評価値を計算しましたが、アルファベータ法を使うと木を枝刈りすることができます。次の図を見てください。
アルファベータ法を使うと、×で示した箇所で枝刈りが行われます。評価値の計算が 5 回で済んでいますね。もちろん、結果（選択した指し手）はミニマックス法と同じです。それでは、なぜ枝刈りが可能なのか説明しましょう。
基本はミニマックス法と同じです。今、C の評価値 3 が決定し、D の評価値を決めるため I の評価値を計算します。その結果、評価値は 4 になりました。この時点で、J の評価値は計算しなくてもいいのです。次の図を見てください。
今、後手が指し手を選ぶところなので、小さな評価値の方を選びます。C の評価値は 3 なので、ここで選択される指し手の評価値は 3 より大きくならないことがわかります。なぜなら、局面 D の評価値が 3 より大きいのであれば、C が選択されることになるからです。
ところが、D の評価値は I の評価値が 4 になった時点で、この値よりも小さな値にはなりません。というのは、I と J を選ぶのは先手なので、大きな評価値の指し手を選ぶからです。したがって、J が 3 より小さな値になったとしても、 D の評価値は 4 になります。また、J の評価値が I より大きくなったとしても、C の評価値 3 より大きな値になるので、けっきょく C が選択されることになります。指し手を決めるために、J の評価値を調べる必要はないのです。
このように、J の枝を枝刈りすることができます。このようなタイプの枝刈りをベータカット (β cut) といい、そのとき基準になる値をベータ値といいます。
これで、局面 A の評価値は 3 に決まりました。次に、B の評価値を求めます。ここでも局面 A の評価値を基準にした枝刈りが可能です。次の図を見てください。
今、先手が指し手を選ぶところなので、大きな評価値の方を選びます。A の評価値は 3 なので、B が選ばれるには 3 より大きい値でなければいけません。まず最初に E の評価値を求めます。これは、K と L の評価値を求めて大きい方を選びます。ここで、E の評価値が 2 に決まると、F の評価値を求める必要はなくなります。
E と F は後手が指し手を選ぶところなので、評価値の小さな指し手を選びます。そして、それが局面 B の評価値になります。したがって、局面 B の評価値は 2 より小さな値にしかなりません。ところが、A と B は先手が指し手を選択するので、大きな評価値の指し手を選びます。A の評価値は 3 で、B の評価値は 2 以下の値にしかならないので、F の評価値を調べなくても A を選ぶことができるのです。
このように、F の枝を枝刈りすることができます。このようなタイプの枝刈りをアルファカット (α cut) といい、そのとき基準になる値をアルファ値といいます。
この「アルファベータ法」がうまく働くと、局面を半分以上評価しないで済ますことができるようです。これは、実際にゲームを作ってその効果を確かめてみましょう。
●アルファベータ法のプログラム
それではアルファベータ法のプログラムを作りましょう。ポイントは基準値（α値、β値）の管理です。プログラムは次のようになります。
リスト : 先手の手番
(define (think-black ls pass limit)
(if (null? ls)
(values (get-value) '())
(let loop ((xs ls) (move #f) (value MIN-VALUE))
(if (null? xs)
(if (not move)
;; パス
(if pass
;; 白黒ともにパス
(values (get-value) (list 'pass))
;; 手番を移す
(let-values (((v m) (think-white ls #t value)))
(values v (cons 'pass m))))
;; 評価値と指し手を返す
(values value move))
(let* ((v #f)
(m #f)
(x (car xs))
(r (get-reverse-stone x 'B)))
(when
(pair? r)
(reverse-stone r 'B)
(put-piece! x 'B)
;; 手番を移す
(let-values (((v1 m1) (think-white (remove x ls) #f value)))
(set! v v1)
(set! m m1))
;; 元に戻す
(reverse-stone r 'W)
(del-piece! x))
;; ミニマックス法
(if (and v (> v value))
;; アルファベータ法
(if (>= v limit)
(values v (cons x m))
(loop (cdr xs) (cons x m) v))
(loop (cdr xs) move value)))))))
引数 limit がアルファベータ法で使用する基準値です。この値は 1 手前の局面の評価値です。変数 value は評価値を格納します。これはミニマックス法と同じです。この値が次の局面（後手番）での基準値となります。
アルファベータ法の処理は簡単です。ミニマックス法で指し手 x を選択した場合、評価値 v が limit 以上の値になった時点で、その指し手と評価値を values で返すだけです。v が limit よりも大きな値になった時点、つまり v > limit で枝刈りしても正常に動作しますが、v >= limit としたほうが効率よく枝刈りできるようです。まだ評価値が求まっていない場合、limit は 1 手前（後手番）の局面の評価値ですから MAX-VALUE がセットされています。MAX-VALUE より大きな評価値はないので、アルファベータ法により枝刈りが実行されることはありません。
後手の指し手を選ぶ関数 think-white は次のようになります。
リスト : 後手の手番
;;; 後手の手番
(define (think-white ls pass limit)
(if (null? ls)
(values (get-value) '())
(let loop ((xs ls) (move #f) (value MAX-VALUE))
(if (null? xs)
(if (not move)
;; パス
(if pass
;; 黒白ともにパス
(values (get-value) (list 'pass))
;; 手番を移す
(let-values (((v m) (think-black ls #t value)))
(values v (cons 'pass m))))
;; 評価値と指し手を返す
(values value move))
(let* ((v #f)
(m #f)
(x (car xs))
(r (get-reverse-stone x 'W)))
(when
(pair? r)
(reverse-stone r 'W)
(put-piece! x 'W)
;; 手番を移す
(let-values (((v1 m1) (think-black (remove x ls) #f value)))
(set! v v1)
(set! m m1))
;; 元に戻す
(reverse-stone r 'B)
(del-piece! x))
;; ミニマックス法
(if (and v (< v value))
;; アルファベータ法
(if (<= v limit)
(values v (cons x m))
(loop (cdr xs) (cons x m) v))
(loop (cdr xs) move value)))))))
先手 (think-black) とは逆に、後手 (think-white) の場合は value を MAX-VALUE で初期化します。後手の場合、ミニマックス法では小さな値を選ぶので、最初に求めた評価値が無条件に選択されます。アルファベータ法の場合も先手とは逆に、v が limit 以下の値になった時点で枝刈りを行えばいいわけです。
●実行結果 (2)
それでは、実行結果を示しましょう。当然ですが、ゲームの結果はミニマックス法とアルファベータ法で変わりはありません。アルファベータ法が有効に機能すれば、ミニマックス法よりも局面の評価回数は少なくなるはずです。結果は次のようになりました。
表 : 局面の評価回数
| W B | W B
初期値| B W | W B
-------+-------+-------
minimax| 60060 | 67116
ab法 | 10016 | 13590
結果を見ればおわかりのように、アルファベータ法の比較回数はミニマックス法の約 1/5 から 1/6 程度になりました。ミニミニリバーシの場合、アルファベータ法の効果はとても高いですね。
●探索順序の変更
一般に、アルファベータ法の探索では、評価値の高い局面から順番に探索すると効率が良くなります。最初に高い評価値が求まると、その値を使って効率よく枝刈りすることができるからです。実際のゲームでも、数レベルの浅い探索を行って評価値を求め、それに基づいて指し手の順番を並べ替えてから、深いレベルの探索を行う場合があります。このように、指し手の順番を並べ替えることでアルファベータ法の効率を改善する方法を move ordering といいます。
もちろん、完全に move ordering することは不可能ですが、指し手が多いゲームでは効果を期待することができます。今回のミニミニリバーシは隅を取ったほうが有利なので、隅に石を置く手から探索すると、move ordering と同様の効果を得ることができると思われます。具体的には、次のように think-black を呼び出します。
リスト : 探索順序の変更
(think-black '(7 10 25 28 8 9 13 16 19 22 26 27)
#f
MAX-VALUE)
これで 4 か所の隅 (7, 10, 25, 28) から探索が行われます。実行結果は次のようになりました。
表 : 局面の評価回数
| W B | W B
初期値 | B W | W B
--------+-------+-------
minimax | 60060 | 67116
ab法 | 10016 | 13590
順序変更| 2387 | 4832
探索順序を変更するだけで、ここまで評価回数を減らすことができるとは驚きました。アルファベータ法の効率は探索する指し手の順序に依存することがよくわかります。
●プログラムリスト１
;;;
;;; rev16.scm : 4 * 4 リバーシ (ミニマックス法)
;;;
;;; Copyright (C) 2010-2020 Makoto Hiroi
;;;
(import (scheme base) (scheme write) (mylib list))
;;; 定数
(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 (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 (think-black ls pass)
(if (null? ls)
(values (get-value) '())
(let loop ((xs ls) (move #f) (value MIN-VALUE))
(if (null? xs)
(if (not move)
;; パス
(if pass
;; 白黒ともにパス
(values (get-value) (list 'pass))
;; 手番を移す
(let-values (((v m) (think-white ls #t)))
(values v (cons 'pass m))))
;; 評価値と指し手を返す
(values value move))
(let* ((v #f)
(m #f)
(x (car xs))
(r (get-reverse-stone x 'B)))
(when
(pair? r)
(reverse-stone r 'B)
(put-piece! x 'B)
;; 手番を移す
(let-values (((v1 m1) (think-white (remove x ls) #f)))
(set! v v1)
(set! m m1))
;; 元に戻す
(reverse-stone r 'W)
(del-piece! x))
;; ミニマックス法
(if (and v (> v value))
(loop (cdr xs) (cons x m) v)
(loop (cdr xs) move value)))))))
;;; 後手の手番
(define (think-white ls pass)
(if (null? ls)
(values (get-value) '())
(let loop ((xs ls) (move #f) (value MAX-VALUE))
(if (null? xs)
(if (not move)
;; パス
(if pass
;; 黒白ともにパス
(values (get-value) (list 'pass))
;; 手番を移す
(let-values (((v m) (think-black ls #t)))
(values v (cons 'pass m))))
;; 評価値と指し手を返す
(values value move))
(let* ((v #f)
(m #f)
(x (car xs))
(r (get-reverse-stone x 'W)))
(when
(pair? r)
(reverse-stone r 'W)
(put-piece! x 'W)
;; 手番を移す
(let-values (((v1 m1) (think-black (remove x ls) #f)))
(set! v v1)
(set! m m1))
;; 元に戻す
(reverse-stone r 'B)
(del-piece! x))
;; ミニマックス法
(if (and v (< v value))
(loop (cdr xs) (cons x m) v)
(loop (cdr xs) move value)))))))
;;; 盤面の表示
(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)))
;;; 実行
(let-values (((v m) (think-black (filter (lambda (x) (eq? (get-piece x) 'S)) (iota 36)) #f)))
(display v) (newline)
(display m) (newline)
(print-move m)
(display *count*) (newline))
●プログラムリスト２
;;;
;;; rev16a.scm : 4 * 4 リバーシ (アルファベータ法)
;;;
;;; Copyright (C) 2010-2020 Makoto Hiroi
;;;
(import (scheme base) (scheme write) (mylib list))
;;; 定数
(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 (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 (think-black ls pass limit)
(if (null? ls)
(values (get-value) '())
(let loop ((xs ls) (move #f) (value MIN-VALUE))
(if (null? xs)
(if (not move)
;; パス
(if pass
;; 白黒ともにパス
(values (get-value) (list 'pass))
;; 手番を移す
(let-values (((v m) (think-white ls #t value)))
(values v (cons 'pass m))))
;; 評価値と指し手を返す
(values value move))
(let* ((v #f)
(m #f)
(x (car xs))
(r (get-reverse-stone x 'B)))
(when
(pair? r)
(reverse-stone r 'B)
(put-piece! x 'B)
;; 手番を移す
(let-values (((v1 m1) (think-white (remove x ls) #f value)))
(set! v v1)
(set! m m1))
;; 元に戻す
(reverse-stone r 'W)
(del-piece! x))
;; ミニマックス法
(if (and v (> v value))
;; アルファベータ法
(if (>= v limit)
(values v (cons x m))
(loop (cdr xs) (cons x m) v))
(loop (cdr xs) move value)))))))
;;; 後手の手番
(define (think-white ls pass limit)
(if (null? ls)
(values (get-value) '())
(let loop ((xs ls) (move #f) (value MAX-VALUE))
(if (null? xs)
(if (not move)
;; パス
(if pass
;; 黒白ともにパス
(values (get-value) (list 'pass))
;; 手番を移す
(let-values (((v m) (think-black ls #t value)))
(values v (cons 'pass m))))
;; 評価値と指し手を返す
(values value move))
(let* ((v #f)
(m #f)
(x (car xs))
(r (get-reverse-stone x 'W)))
(when
(pair? r)
(reverse-stone r 'W)
(put-piece! x 'W)
;; 手番を移す
(let-values (((v1 m1) (think-black (remove x ls) #f value)))
(set! v v1)
(set! m m1))
;; 元に戻す
(reverse-stone r 'B)
(del-piece! x))
;; ミニマックス法
(if (and v (< v value))
;; アルファベータ法
(if (<= v limit)
(values v (cons x m))
(loop (cdr xs) (cons x m) v))
(loop (cdr xs) move value)))))))
;;; 盤面の表示
(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)))
;;; 実行
(let-values (((v m)
(think-black (filter (lambda (x) (eq? (get-piece x) 'S)) (iota 36)) #f MAX-VALUE)))
(display v) (newline)
(display m) (newline)
(print-move m)
(display *count*) (newline))
改訂 2020 年 10 月 18 日