さて、今回はVBAを使ってゲームを作ってみましょう。
ここでは、エクセルのセルを盤面として利用したリバーシを作ってみることにします。
ちなみにリバーシとは、黒番と白番に分かれて互いに石を置きあって自分側の石で挟まれた相手側の石をひっくり返していき、最終的に石が多い側の勝ちとするボードゲームです。
解説を省略しているところが多いかもしれませんが、コードを追っていただければ何をしているかが分かると思います。
ざっくりと以下のような流れで進めていきます。
- ゲーム盤面の作成 ・・・ エクセルのシート上にリバーシの盤面（見た目の部分）を作ります。
- データ構造の検討 ・・・ 盤面の状態を管理するための変数や定数のデータ構造を考えます。
- 表示更新 ・・・ 内部的なデータをシート上の盤面に反映する方法を考えます。
- 合法手の判定 ・・・ 盤面のどこに石を置くことができるかを判定するプログラムを考えます。
- プレイヤー側の着手 ・・・ 実際に石を置く動作をどのように実現するかを考えます。
- コンピュータ側の着手 ・・・ コンピュータが次の一手を決定するためのプログラムを考えます。
- ゲームの進行管理 ・・・ ここまでの機能を組み込み、ゲームの進行をどのように管理するかを考えます。
- まとめ ・・・ サンプルコードをまとめて記載します。
- 遊んでみる ・・・ 実際に出来上がったゲームで遊んでみます。
ゲーム盤面の作成
まず、リバーシの盤面を考えてみます。
リバーシには縦8×横8マスの計64マスの盤面が必要ですが、エクセルのセルを使えば簡単に表現することができます。
新しいファイルを作成し、「リバーシ」という名前のシートを作りましょう。そして、以下の画像を参考にしてレイアウトを変更してください。
「盤面」と「対局開始」ボタン、「プレイヤーとコンピュータの石の色」と「黒と白の石の数」を表示するところがあればとりあえずはゲームができるはずです。
ですが、自分の手番で置くところがなくなった場合に「パス」の機能が必要なのと、プレイヤーとコンピュータの手番を変更する機能があった方がよいでしょう。
見た目で一番大事なのはマスと文字の大きさですが、ここではマスを60ピクセル×60ピクセル、フォントサイズは28にしています。
黒石は●、白石は○で表すことにします。
データ構造の検討
盤面の見た目ができたので、今度は内部的なデータについて考えてみましょう。
盤面には64個のマスがありますから、これを表現するために単純に要素数が64の配列を用意することにします。
Dim board(63) As Byte '現在の盤面配列(左上のインデックスが0、右下が63)
この盤面配列に格納される値ですが、マスの状態としては0:何も置かれていない、1:黒が置かれている、2:白が置かれている、の3通りと考えられます。これを石の色としてDiscColorという名前のEnumで定義しておきます。
ついでに、黒と白を反転させるためのビットデータとして、ChangeColorを定義しておきます。
黒は00000001B、白は00000010Bですから、DiscColor.Black xor ChangeColorで白(00000010B)、DiscColor.White xor ChangeColorで黒(00000001B)を得ることができます。
Enum DiscColor '石の色（手番）
None = 0 '白でも黒でもない（空き）
Black = 1 '黒
White = 2 '白
End Enum
Const ChangeColor As Byte = DiscColor.Black Or DiscColor.White '黒白反転用データ（00000011B）
Enumは最初に定義したものが0、続く値は1,2…と自動的に連番になりますが、ここでは明示的に値を宣言しています。
石を置く側の手番もDiscColorを利用して、0:どちらの手番でもない、1:黒の番、2:白の番、の3通りで表現できそうです。
ゲームの状態として、1:プレイヤーが黒でコンピュータが白、2:プレイヤーが白でコンピュータが黒の2通りを考えることとし、以下のように宣言しておきます。コンピュータ対コンピュータや自分で黒白両方並べることについてはここでは説明しませんが、もし興味があればぜひ作ってみてください。
Enum GameMode '対局モードの種類
BlackPlayer = 1 'プレイヤーが黒
WhitePlayer = 2 'プレイヤーが白
End Enum
対局モード、手番、ゲーム中の手数（何手目まで進んだか）をそれぞれ以下のように宣言します。手数は盤面が64マスあり、最初に4つの石が置かれていますので、0から始めて一手進むごとに加算し、60になった時点で盤上のすべてのマスが埋まることになります。
Dim mode As Byte '対局モード
Dim turn As Byte '現在の手番(0:操作不可,1:黒の手番,2:白の手番)
Dim tekazu As Integer '現在の手数
そして最後に、どのマスに石を置くことができるかを表す合法手リストを、Dictionaryを使って以下のように宣言します。
Dim handList As Dictionary '現在の手番側が着手可能な位置のディクショナリ
handListにはKeyとして手番側が置くことのできる位置を、ItemとしてKeyの位置に置いた場合に反転させることができる相手の石の位置をCollectionで格納することにします。handListの内容の更新については後で説明しますが、具体的に初期盤面の黒番では以下のようになります。
これが意味するところは、黒は盤上の4か所(board配列内のインデックスが19,26,37,44の位置)に石を置くことができ、その際にひっくり返すことができる白石の位置は黒石19と26に対して27の白石、黒石37と44に対して36の白石であるということです。
表示更新
シート上に作ったリバーシ盤面に、内部的な盤面の状況を反映させる方法を考えます。
64マス分のバイト配列の中身を対応するセルに書き込むだけですが、board(63)の各要素の値は0(DiscColor.None)、1(DiscColor.Black)、2(DiscColor.White)のいずれかであるはずですから、これをそれぞれ空白、●、○に変換して表示します。
また、これは盤面の表示が更新された時の処理になりますから、このタイミングで盤上の黒石の数と白石の数を集計して表示するようにします。
同時に、手数が60に達した（盤面が埋まった）か、いずれかの石の数が0になったかを判定し、ゲームが終局であればどちらが勝ったかを表示するようにしておきます。
'/******************************
' 盤面表示と着手リストの更新
'******************************/
Sub showBoard()
Dim i As Integer
Dim blackCnt As Long
Dim whiteCnt As Long
For i = 0 To 63
If board(i) = DiscColor.Black Then
Sheets("Board").Cells(Int(i / 8) + 1, i Mod 8 + 1) = "●" '黒の石を表示
blackCnt = blackCnt + 1
ElseIf board(i) = DiscColor.White Then
Sheets("Board").Cells(Int(i / 8) + 1, i Mod 8 + 1) = "○" '白の石を表示
whiteCnt = whiteCnt + 1
End If
Next
makeList handList, board, turn '着手リストを更新
Cells(7, 11) = blackCnt
Cells(8, 11) = whiteCnt
If tekazu = 60 Then
If blackCnt > whiteCnt Then
MsgBox "黒の勝ち！"
ElseIf whiteCnt > blackCnt Then
MsgBox "白の勝ち！"
Else
MsgBox "引き分け"
End If
ElseIf blackCnt = 0 Then
MsgBox "白の勝ち！"
ElseIf blackCnt = 0 Then
MsgBox "黒の勝ち！"
End If
End Sub
この中にあるmakeListは合法手リスト、盤面、手番を引数で渡すと、その局面における手番側の合法手リストを更新してくれる関数です。詳細は次で説明します。
合法手の判定
さて、リバーシでは空いているマスならどこでも自分の石が置けるわけではなく、相手の石を自分の石で挟むような位置にしか置くことができません。手番側の石を置くことができる位置の一覧(合法手リスト)を更新するプログラムについて考えてみましょう。
'/******************************
' 着手リスト作成処理
'
' 着手可能な位置の条件
' 1.空きマスであること
' 2.相手石に隣接していること
' 3.相手石方向の端に自分の石があること
'******************************/
Sub makeList(ByRef list, checkBoard, checkTurn)
Dim enemyList As New Collection '反転させる相手石の位置リスト
Dim enemy As Variant '相手石の位置
Dim pos As Integer '位置
Dim i As Integer '同一方向の石を数えるためのカウンタ
Dim putR As Integer '着手位置の縦座標
Dim putC As Integer '着手位置の横座標
Dim moveR As Integer '縦方向へのオフセット
Dim moveC As Integer '横方向へのオフセット
Set list = New Dictionary '着手リストを初期化
For putR = 0 To 7 '縦座標
For putC = 0 To 7 '横座標
If checkBoard(putR * 8 + putC) = DiscColor.None Then 'まだ石が置かれていない場合
For moveR = -1 To 1 '縦方向のオフセット
For moveC = -1 To 1 '横方向のオフセット
If Not ((moveR = 0) And (moveC = 0)) Then 'オフセットが(0,0)の場合はスキップ
Set enemyList = New Collection '相手石の位置リスト初期化
For i = 1 To 7 '石を置く位置の隣から直線方向に最大7マス判定
If (putR + moveR * i < 0) Or (putR + moveR * i > 7) Then '盤面の上下端を超える場合
Exit For 'この方向の判定終了(着手不可)
ElseIf (putC + moveC * i < 0) Or (putC + moveC * i > 7) Then '盤面の左右端を超える場合
Exit For 'この方向の判定終了(着手不可)
End If
pos = (putR + moveR * i) * 8 + (putC + moveC * i) '判定するマスの位置
If checkBoard(pos) = DiscColor.None Then '石が置いていない場合
Exit For 'この方向の判定終了(着手不可)
ElseIf checkBoard(pos) = (checkTurn Xor ChangeColor) Then '相手の石が置いてある場合
enemyList.Add pos '相手の石リストに位置を追加
Else '自分の駒
If enemyList.Count > 0 Then '間に相手の駒があった場合(着手可)
If list.Exists(putR * 8 + putC) = False Then '着手位置が着手リストに登録されていない場合
list.Add putR * 8 + putC, New Collection '着手位置を着手リストのキーに追加
End If
For Each enemy In enemyList '相手の石リストの内容を着手リストに反映
list(putR * 8 + putC).Add enemy '着手位置に対応する相手石リストに相手石の位置を追加
Next
End If
Exit For 'この方向の判定終了
End If
Next
End If
Next
Next
End If
Next
Next
End Sub
合法手リストを更新する関数であるmakeListは、合法手リスト、盤面、手番を引数として受け取ります。合法手リストがByRef(参照渡し)であることに注意してください。これにより、makeList関数の中で呼び出し元が指定した合法手リスト自体の内容を変更（合法手を追加）することができます。
この関数は、盤面の左上(0)から右下(63)に向かって1マスずつ空きマスを探します。
空きマスが見つかった場合、そのマスに隣接するマスに相手の石が置いてあるか否かを全方向(8方向)に向けてチェックします。
相手の石に隣接している場合、隣接する相手石方向の反対側に自分の石が置かれているかをチェックします。
ここで盤面の端を超えるまでに自分の石が見つかった場合、間に挟まれた相手の石を反転させることができると確定します。この相手石の位置をenemyList(反転させることができる相手石の位置リスト)に追加していきます。
全方向のチェックが終了した時点でenemyListに値が入っている場合(反転させる相手石がある＝この空きマスに着手可能)、この空きマスを合法手としてlistに着手位置とenemyListのペアで追加していきます。
これを繰り返し、盤上のマスをすべてチェックして合法手リストの更新処理は終了です。
このように合法手リストを作ることで、石を置くことができる場所と、その際反転させることができる相手石の位置を判断しやすくなり、スムーズにゲームを進行させることができるようになります。
プレイヤー側の着手
それでは、実際にプレイヤーが石を置く動作を実装してみましょう。
盤面内のセルがクリックされたとき、プレイヤーの手番でかつクリックしたセルの位置が着手可能位置である(handListに登録されている)場合、そのセルにプレイヤーの手番の石を置くことにします。これにはWorksheet_SelectionChangeイベントを使います。
このイベントに対応する関数が登録されたシートでは、「新たなセルの選択」というイベントの発生に対してWorksheet_SelectionChange内で定義した処理が実行されます。
'/******************************
' 盤面選択時の処理
'******************************/
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim pos As Long
pos = (Target.Row - 1) * 8 + Target.Column - 1 '盤面内換算のインデックス
If (turn And mode) <> 0 Then 'プレイヤーの手番と現在の手番が一致
If Target.Row <= 8 And Target.Column <= 8 Then '選択した位置が盤面内の場合
If handList.Exists(pos) Then '選択位置が着手可能位置リストに登録済みの場合
putDisc pos, turn, handList(pos), board, turn, tekazu '一手進行
showBoard '盤面表示
End If
End If
comhand 'コンピュータの手番
End If
End Sub
クリックされた位置をRange型のTargetで受け取っているため、これを0～63のインデックスに変換します。
このとき、有効な盤面の範囲はcells(1,1)からcells(8,8)ですから、それ以外の場所をクリックされても着手とはみなさないようにしておきます。
また、コンピュータの手番中にプレイヤーが着手するのを防ぐため、現在の手番がプレイヤーの手番と一致する場合のみ着手可能としています。
プレイヤーの手番で盤面内がクリックされた場合、handList内にクリックされた位置が登録されていれば、一手進行させる処理であるputDisc関数を呼び出します。
'/******************************
' 一手進行処理
'
' 渡された盤面を更新して手番を交代する処理
' 引数 着手位置,着手側の色,反転させる位置リスト,ref 盤面,ref 手番
'******************************/
Sub putDisc(putpos, disc, reverseList, ByRef changeBoard, ByRef changeTurn, ByRef handNum)
Dim revpos '反転させる石の位置
changeBoard(putpos) = disc '手番側の石を置く
For Each revpos In reverseList
changeBoard(revpos) = disc '相手の石を反転
Next
passHand changeTurn, handNum
End Sub
'/******************************
' パス（手番交代及び手数加算処理)
'
'******************************/
Sub passHand(ByRef changeTurn, ByRef handNum)
changeTurn = (changeTurn Xor ChangeColor) '手番を交代する
handNum = handNum + 1 '手数を加算
End Sub
putDisc関数は、着手位置と着手側の石の色、反転させる相手石のリスト、現在の盤面、現在の手番、現在の手数を渡すと、内部的に盤面の状態を更新して手番を交代し、手数を加算する関数です。
ここで、実際の画面表示を更新しない点に注意してください。これは、実際に表示を更新せずに先読みを行う際にもこの処理を使用するためです。
また、手番を交代する処理として、passHand関数を定義しています。この処理は、自手番での合法手がなくなった場合にパスをする際にも利用するため、実際に石を置く処理とは分離しています。
もし関数を増やしたくない場合には、石を置く場合に指定する位置を特定の値にしておいて、その場合はputDisc関数内でパスを意味するものとして扱うようにしてもよいでしょう。
コンピュータ側の着手
次に、コンピュータが着手を行うプログラムを作成します。
コンピュータの手番でなければ、処理をスキップするようにします。
'/******************************
' コンピュータの思考
'******************************/
Sub comhand()
If turn <> 0 And (turn And mode) = 0 Then 'コンピュータの手番
Dim hand
Dim score As New Dictionary
Dim i As Long
If handList.Count = 0 Then 'コンピュータの合法手がない場合
passHand turn, tekazu 'パス
makeList handList, board, turn '着手リストを更新
tekazu = tekazu - 1 'パスした分の手数を調整
Exit Sub
End If
Cells(5, 12) = "思考中"
For Each hand In handList.Keys '現在の合法手
score.Add hand, 0
For i = 0 To 20 '適当な回数繰り返し
DoEvents
score(hand) = score(hand) + simulate(board, turn, tekazu, hand)
Next
Next
Dim besthand
besthand = -1
If turn = DiscColor.Black Then
For Each hand In handList.Keys '現在の合法手
If besthand = -1 Then
besthand = hand
End If
If score(hand) > score(besthand) Then
besthand = hand
End If
Next
Else
For Each hand In handList.Keys '現在の合法手
If besthand = -1 Then
besthand = hand
End If
If score(hand) < score(besthand) Then
besthand = hand
End If
Next
End If
Cells(5, 12) = "" '思考中の表示を消す
putDisc besthand, turn, handList(besthand), board, turn, tekazu '一手進行
showBoard '盤面表示
End If
End Sub
コンピュータの手番では、先読み処理に時間がかかりますので、セル上に"思考中"の文字列を表示しています。
ここではコンピュータが着手可能なすべての手に対して21回ずつ先読みして評価(score関数の戻り値)を得るようにしています。
手番に応じて得られた評価の合計が最大となるような着手を選択し、最初に表示した"思考中"の表示を消したのちに盤面を更新しています。
以下が、次の一手を評価するためのscore関数です。
'/******************************
' 終局までランダムシミュレーション
'******************************/
Function simulate(ByVal testBoard, ByVal testTurn, ByVal testTekazu, hand)
Dim ransuu As Long
Dim i As Long
Dim testList As New Dictionary
Dim limit As Long
limit = 60 - testTekazu '終局までの残り手数
putDisc hand, testTurn, handList(hand), testBoard, testTurn, testTekazu '最初の石を置いてみる
makeList testList, testBoard, testTurn 'コンピュータ用の着手リストを更新
For i = 0 To limit '終局までの手数
If testList.Count = 0 Then '合法手がない場合
Exit For
End If
ransuu = Fix(rnd * testList.Count) '合法手の中から手をランダムで選択
putDisc testList.Keys(ransuu), testTurn, testList(testList.Keys(ransuu)), testBoard, testTurn, testTekazu '石を置いてみる
makeList testList, testBoard, testTurn '着手リストを更新
Next
Dim cntBlack As Long
Dim cntWhite As Integer
cntBlack = 0 '黒石の数初期化
cntWhite = 0 '白石の数初期化
For i = 0 To 63
If testBoard(i) = DiscColor.Black Then
cntBlack = cntBlack + 1 '盤面の黒石を数える
ElseIf testBoard(i) = DiscColor.White Then
cntWhite = cntWhite - 1 '盤面の白石を数える
End If
Next
simulate = cntBlack + cntWhite
End Function
残りの手数に応じて終局までランダムに手を選択しながら石を打ち続けます。
最終的に盤上の黒石を1点、白石を-1点として数え、合計値を返しています。最終的に黒なら点数が高い手、白なら点数が低い手を選びます。
今回は21回の試行なので、精度がかなり低いです。
特に序盤は残り手数が多いため時間がかかり、終盤は短い時間で処理が終わり、改善の余地が多いです。
このようなゲームで評価値を得る方法はいろいろありますが、これは一例です。
序盤では終局までランダムにシミュレーションするよりも次の相手の合法手の数が少なくなるような着手を探した方が効果的かもしれませんし、盤面の端や角にある石の価値を高く評価した方がより強いコンピュータの思考を実現できるでしょう。
興味があればαβ法などを調べて研究してみると面白いと思います。
これでほとんどの部品は出来上がりました。次のページでこれらを組み合わせてリバーシを完成させてみましょう。