求五子棋人机对战算法

总的来说，要让电脑知道该在哪一点下子，就要根据盘面的形势，为每
一可能落子的点计算其重要程度，也就是当这子落下后会形成什么棋型（如：“冲四”、“活三”等），然后通览
全盘选出最重要的一点，这便是最基本的算法。当然，仅靠当前盘面进行判定是远远不够的，这样下棋很轻易掉进
玩家设下的陷阱，因为它没有考虑以后的变化。所以在此基础上我们加入递归调用，即：在电脑中猜测出今后几步
的各种走法，以便作出最佳选择，这也是我们下棋时常说的“想了几步”。如此一来您的程序便具有一定的水平了。
什么？不信！过来试试吧！
总体思路弄清之后，下面进行具体讨论：
一：数据结构
先来看看数据结构，我们需要哪些变量？
首先得为整个棋盘建立一张表格用以记录棋子信息，我们使用一个15*15的二维数组 Table[15][15] (15*15是
五子棋棋盘的大小)，数组的每一个元素对应棋盘上的一个交叉点，用‘0’表示空位、‘1’代表己方的子、‘2’
代表对方的子；这张表也是今后分析的基础。
在此之后还要为电脑和玩家双方各建立一张棋型表Computer[15][15][4]和Player[15][15][4]，用来存放棋型
数据，就是刚才所说的重要程度，比如用‘20’代表“冲四”的点，用‘15’代表“活三”的点，那么在计算重要
性时，就可以根据20>15得出前者比后者重要，下子时电脑便会自动选择“冲四”的点。那为什么棋型表要使用三
维数组呢？因为棋盘上的每一个点都可以与横、竖、左斜、右斜四个方向的棋子构成不同的棋型，所以一个点总共
有4个记录；这样做的另一个好处是可以轻易判定出复合棋型，例如：假如同一点上有2个‘15’就是双三、有一个‘15’和一个‘20’就是四三。
怎么样！3个数组构成了程序的基本数据骨架，今后只要再加入一些辅助变量便可以应付自如了。应该不会太
难吧？OK！有了这么多有用的数据，我们就可以深入到程序的流程中去了。
二：程序流程
我们主要讨论五子棋的核心算法，即：人工智能部分，而其他像图形显示、键盘鼠标控制等，因较为简单，所
以就不作过多介绍了。
我们看到本程序由六个基本功能模块构成，各模块的具体分析如下：
（1）初始化：首先，建立盘面数组Table[15][15]、对战双方的棋型表Computer[15][15][4]和Player[15]
[15][4]并将它们清零以备使用；然后初始化显示器、键盘、鼠等输入输出设备并在屏幕上画出棋盘。
（2）主循环控制模块：控制下棋顺序，当轮到某方下子时，负责将程序转到相应的模块中去，主要担当一个
调度者的角色。
（3）玩家下子：当轮到玩家下时，您通过键盘或鼠标在棋盘上落子，程序会根据该点的位置，在Table[15]
[15]数组的相应地方记录‘2’，以表明该子是玩家下的。
（4）盘面分析填写棋型表：本程序核心模块之一，人工智能算法的根本依据！其具体实现方法如下：您在下
五子棋时，一定会先根据棋盘上的情况，找出当前最重要的一些点位，如“活三”、“冲四”等；然后再在其中
选择落子点。但是，电脑不会像人一样分析问题，要让它知道哪是“活三”、哪是“冲四”，就得在棋盘上逐点
计算，一步一步的教它。
先来分析己方的棋型，我们从棋盘左上角出发，向右逐行搜索，当碰到一个空白点时，以它为中心向左挨个
查找，假如碰到己方的子则记录然后继续，假如碰到对方的子、空白点或边界就停止查找。左边完成后再向右进
行同样的操作；最后把左右两边的记录合并起来，得到的数据就是该点横向上的棋型，然后把棋型的编号填入到Computer[x][y][n]中就行了（x、y代表坐标，n=0、1、2、3分别代表横、竖、左斜、右斜四个方向）。而其他三
个方向的棋型也可用同样的方法得到，当搜索完整张棋盘后，己方棋型表也就填写完毕了。然后再用同样的方法
填写对方棋型表。
注重：所有棋型的编号都要事先定义好，越重要的号数越大！
OK! 怎么样？有点累了吧？不过千万别泄气！因为好戏还在后头。
Let's go！
（5）电脑下子：有了上面填写的两张棋型表，现在要作的就是让电脑知道在哪一点下子了。其中最简单的
计算方法，就是遍历棋型表Computer[15][15][4]和Player[15][15][4]找出其中数值最大的一点，在该点下子即
可。但这种算法的弱点非常明显，只顾眼前利益，不能顾全大局，这就和许多五子棋初学者一样犯了“目光短浅”
的毛病。
要解决这个问题，我们引入‘今后几步猜测法’，具体方法是这样的： 首先， 让电脑分析一个可能的点，
假如在这儿下子将会形成对手不得不防守的棋型（例如：‘冲四’、‘活三’）；那么下一步对手就会照您的思
路下子来防守您，如此一来便完成了第一步的猜测。这时再调用模块4对猜测后的棋进行盘面分析，假如出现了
‘四三’、‘双三’或‘双四’等制胜点，那么己方就可以获胜了（当然对黑棋而言‘双三’、‘双四’是禁手
，另当别论）；否则照同样的方法向下分析，就可猜测出第二步、第三步……
等一等，要是盘面上没有对手必须防的棋型，哪该怎么办呢？进攻不成的话就得考虑防守了，将自己和对手
调换一下位置，然后用上面的方法来猜测对手的棋，这样既可以防住对手巧妙的攻击，又能侍机发动反击，何乐
而不为呢！
但是必须告诉大家的是：猜测法的运算量相当之大，据我的经验，用Pentium-100猜测3步的走法平均需要15
秒以上时间，所以建议猜测量在5步以内。可别小瞧了这5步，有时它甚至会走出让您拍手叫绝的妙着呢！
（6）胜败判定：务须多言，某方形成五子连即获胜；若黑棋走出‘双三’、‘双四’或长连即以禁手判负。
到现在为止，整个五子棋软件就基本完成了，其水平大约在中级上下。当然，这种算法并不是最好的，但我
相信它的基本思路是正确的。

'在窗体上加入以下控件
'image1(0),image1(0) - 黑白棋图片
'image2,image3(0)
'form中的picture图片为棋盘。因无法上传，请自行领会。

Option Explicit
Dim I, J, K, Counter, Firstmoved, Rt, Gen, r, flag As Integer
Dim Grid(225), H(224), V(224), RL(224), LR(224), Tb(2), Order(225) As Integer

Private Sub Form_Initialize()
lblHelp.Top = 0
lblHelp.Left = 0
Image1(0).Top = -1000
Image1(1).Top = -1000
lblHelp.Left = -lblHelp.Width

lblHelp = vbCrLf + vbCrLf + " 游戏帮助" + vbCrLf _
+ vbCrLf + vbCrLf + "●游戏规则:黑方先行,轮流弈子,任一方向先连成五子者胜." _
+ vbCrLf + vbCrLf + vbCrLf + "●操作提示:①可选择[先后]、[难度]和[对手]菜单设置游戏," _
+ vbCrLf + vbCrLf + " 只有按[游戏]->[开始]后才可在棋盘上落子." _
+ vbCrLf + vbCrLf + " ②按[游戏]->[清盘]可重玩并设置游戏." _
+ vbCrLf + vbCrLf + " ③落子后按[动作]菜单下的选择可任意悔棋和恢复." _
+ vbCrLf + vbCrLf + " ④各功能菜单都提供了快捷键(Alt+相应字母)." _
+ vbCrLf + vbCrLf + vbCrLf + "●有什么问题请与本人联系.电子邮件:xwwxyz@sina.com." _
+ vbCrLf + vbCrLf + vbCrLf + "●本页面单击后隐藏."
End Sub

Private Sub Form_Resize()
Me.Height = 5800
Me.Width = 5100
End Sub

Private Sub lblHelp_Click()
lblHelp.Visible = False
End Sub

Private Sub mnuAfter_Click()
Firstmoved = 0
mnuAfter.Checked = True
mnuFirst.Checked = False
End Sub

Private Sub Form_Load()
Dim I As Integer
For I = 1 To 224
Load Image3(I) '加载棋子控件
Image3(I).Top = (I \ 15) * 22 + 5
Image3(I).Left = (I Mod 15) * 22 + 5
Image3(I).Visible = True
Next
Ini
End Sub

'游戏初始化
Sub Ini()
For I = 0 To 224
Image3(I) = Image2
Image3(I).Enabled = False
Grid(I) = 0
V(I) = 0
H(I) = 0
LR(I) = 0
RL(I) = 0
Next I
mnuBack.Enabled = False
Counter = 0
Gen = 0
If mnuAfter.Checked = True Then
Firstmoved = 0
Else
Firstmoved = 1
End If
mnuStart.Enabled = True
End Sub

'一方是否可获胜
Function LineWin(Piece As Integer) As Integer
Dim mun As Integer
LineWin = 225
'五子一线
mun = Piece * 5
For I = 0 To 224
If H(I) = mun Or V(I) = mun Or RL(I) = mun Or LR(I) = mun Then
LineWin = 225 + Piece
Exit Function
End If
Next I

'四子一线
mun = Piece * 4
For I = 0 To 224
If H(I) = mun Then
For K = 0 To 4
If Grid(I + K) = 0 Then LineWin = I + K: Exit Function
Next K
End If

If V(I) = mun Then
For K = 0 To 4
If Grid(I + K * 15) = 0 Then LineWin = I + K * 15: Exit Function
Next K
End If

If RL(I) = mun Then
For K = 0 To 4
If Grid(I + K * 14) = 0 Then LineWin = I + K * 14: Exit Function
Next K
End If

If LR(I) = mun Then
For K = 0 To 4
If Grid(I + K * 16) = 0 Then LineWin = I + K * 16: Exit Function
Next K
End If
Next I
End Function

'计算机走棋
Sub ComputerMove()
Dim ToMove As Integer
If Counter = 0 Then
Randomize
I = Int(Rnd * 7 + 4)
J = Int(Rnd * 7 + 4)
If Grid(I * 15 + J) = 0 Then ToMove = I * 15 + J
Else
If mnuLower.Checked = True Then ToMove = Defend Else ToMove = Attempt
End If
Counter = Counter + 1
If Firstmoved = 0 Then Image3(ToMove) = Image1(0) Else Image3(ToMove) = Image1(1)
Grid(ToMove) = 2
Order(Counter) = ToMove
LineGen ToMove, 6
If LineWin(6) = 231 Then
MsgBox "您输了!"
Ini
Exit Sub
End If
If Counter = 225 Then
MsgBox "和棋"
Ini
Exit Sub
End If
End Sub

'低级模式
Function Defend() As Integer
Rt = LineWin(6)
If Rt < 225 Then Defend = Rt: Exit Function
Rt = LineWin(1)
If Rt < 225 Then Defend = Rt: Exit Function
'查找落子位置
Rt = FindBlank
If Rt < 225 Then Defend = Rt: Exit Function
End Function

'悔棋
Private Sub mnuBack_Click()
mnuComeback.Enabled = True
If (Counter + Firstmoved) Mod 2 = 0 Then Rt = -1 Else Rt = -6
Grid(Order(Counter)) = 0
Image3(Order(Counter)) = Image2
LineGen Order(Counter), Rt
Counter = Counter - 1
If mnuComputer.Checked = True Then
Grid(Order(Counter)) = 0
Image3(Order(Counter)) = Image2
LineGen Order(Counter), -1
Counter = Counter - 1
Else
flag = 1 - flag
End If
r = r + 1
If Counter = 1 And Firstmoved = 0 And mnuComputer.Checked = True Then mnuBack.Enabled = False
If Counter = 0 Then mnuBack.Enabled = False
End Sub

'恢复棋子
Private Sub mnuComeback_Click()
mnuBack.Enabled = True
Counter = Counter + 1
If (Counter + Firstmoved) Mod 2 = 0 Then
Grid(Order(Counter)) = 1
Image3(Order(Counter)) = Image1(1 - Firstmoved)
LineGen Order(Counter), 1
Else
Grid(Order(Counter)) = 2
Image3(Order(Counter)) = Image1(Firstmoved)
LineGen Order(Counter), 6
End If
If mnuComputer.Checked = True Then
Counter = Counter + 1
Grid(Order(Counter)) = 2
Image3(Order(Counter)) = Image1(Firstmoved)
LineGen Order(Counter), 6
Else
flag = 1 - flag
End If
r = r - 1
If r = 0 Then mnuComeback.Enabled = False
End Sub

Private Sub mnuComputer_Click() '对手
mnuComputer.Checked = True '电脑
mnuHuman.Checked = False '棋手
End Sub

Private Sub mnuClear_Click() '清盘
Ini
mnuFirst.Enabled = True
mnuAfter.Enabled = True
mnuLower.Enabled = True
mnuHigher.Enabled = True
mnuComputer.Enabled = True
mnuHuman.Enabled = True
End Sub

Private Sub mnuHuman_Click()
mnuHuman.Checked = True
mnuComputer.Checked = False
End Sub

Private Sub mnuStart_Click() '开始
lblHelp.Visible = False
For I = 0 To 224
Image3(I).Enabled = True
Next I
mnuFirst.Enabled = False
mnuAfter.Enabled = False
mnuLower.Enabled = False
mnuHigher.Enabled = False
mnuComputer.Enabled = False
mnuHuman.Enabled = False
If Firstmoved = 0 And mnuComputer.Checked = True Then ComputerMove
If Firstmoved = 0 And mnuHuman.Checked = True Then flag = 1 Else flag = 0
mnuStart.Enabled = False
End Sub

'玩家走棋
Private Sub image3_Click(Index As Integer)
If Grid(Index) <> 0 Then Exit Sub
Counter = Counter + 1
If Firstmoved = 0 Then
Image3(Index) = Image1(1 - flag)
Else
Image3(Index) = Image1(flag)
End If
Grid(Index) = 1 + flag
Order(Counter) = Index
mnuBack.Enabled = True
mnuComeback.Enabled = False
r = 0
LineGen Index, (1 + flag * 5)
If LineWin(1 + flag * 5) = 226 + flag * 5 Then
If flag = 0 Then MsgBox "您赢了!" Else MsgBox "您输了!"
Ini
Exit Sub
End If
If Counter = 225 Then
MsgBox "和棋"
Ini
Exit Sub
End If

If mnuComputer.Checked = True Then ComputerMove Else flag = 1 - flag
End Sub

'查找可以落子的空位
Function FindBlank() As Integer
Dim wz, fs, lz, RndNum As Integer
fs = -10000
For wz = 0 To 224
If Grid(wz) = 0 Then
Grid(wz) = 2
LineGen wz, 6
Rt = Gen
If Rt > fs Then fs = Rt: lz = wz
Grid(wz) = 0
LineGen wz, -6
End If
Next wz
FindBlank = lz
End Function

'高级模式
Function Attempt() As Integer
Dim wz As Integer
Rt = LineWin(6)
If Rt < 225 Then Attempt = Rt: Exit Function
Rt = LineWin(1)
If Rt < 225 Then Attempt = Rt: Exit Function
'查找落子位置
Rt = linethree(6)
If Rt < 225 Then Attempt = Rt: Exit Function

Rt = linethree(1)
If Rt < 225 Then
Grid(Tb(0)) = 2
LineGen Tb(0), 6
Rt = Gen: wz = Tb(0)
Grid(Tb(0)) = 0
LineGen Tb(0), -6
Grid(Tb(1)) = 2
LineGen Tb(1), 6
If Rt < Gen Then Rt = Gen: wz = Tb(1)
Grid(Tb(1)) = 0
LineGen Tb(1), -6
Grid(Tb(2)) = 2
LineGen Tb(2), 6
If Rt < Gen Then Rt = Gen: wz = Tb(2)
Grid(Tb(2)) = 0
LineGen Tb(2), -6
Attempt = wz
Exit Function
End If

Rt = FindBlank
If Rt < 225 Then Attempt = Rt: Exit Function
End Function

Private Sub mnuFirst_Click() '先后手
Firstmoved = 1
mnuAfter.Checked = False
mnuFirst.Checked = True
End Sub

Private Sub mnuHigher_Click()
mnuLower.Checked = False
mnuHigher.Checked = True
End Sub

Private Sub mnuLower_Click() '难度
mnuLower.Checked = True
mnuHigher.Checked = False
End Sub

'局势评估
Function LineGen(ij, Piece)
Dim b, e, mun As Integer
I = ij \ 15
J = ij Mod 15
'横线影响
b = IIf(J - 4 > 0, J - 4, 0)
e = IIf(J > 10, 10, J)
For K = b To e
mun = H(I * 15 + K)
If mun < 6 Then Gen = Gen + mun * 2 ^ mun
If mun > 5 And mun Mod 6 = 0 Then mun = mun \ 6 - 1: Gen = Gen - mun * 2 ^ mun
H(I * 15 + K) = H(I * 15 + K) + Piece
mun = H(I * 15 + K)
If mun < 6 Then Gen = Gen - mun * 2 ^ mun
If mun > 5 And mun Mod 6 = 0 Then mun = mun \ 6 - 1: Gen = Gen + mun * 2 ^ mun
Next K

'竖线影响
b = IIf(I - 4 > 0, I - 4, 0)
e = IIf(I > 10, 10, I)
For K = b To e
mun = V(K * 15 + J)
If mun < 6 Then Gen = Gen + mun * 2 ^ mun
If mun > 5 And mun Mod 6 = 0 Then mun = mun \ 6 - 1: Gen = Gen - mun * 2 ^ mun
V(K * 15 + J) = V(K * 15 + J) + Piece
mun = V(K * 15 + J)
If mun < 6 Then Gen = Gen - mun * 2 ^ mun
If mun > 5 And mun Mod 6 = 0 Then mun = mun \ 6 - 1: Gen = Gen + mun * 2 ^ mun
Next K

'撇线影响
b = IIf(I - 4 > 0, I - 4, 0)
e = IIf(I > 10, 10, I)
b = IIf(b > J + I - IIf(J + 4 > 14, 14, J + 4), b, J + I - IIf(J + 4 > 14, 14, J + 4))
e = IIf(e > J + I - IIf(J > 4, J, 4), J + I - IIf(J > 4, J, 4), e)
For K = b To e
mun = RL(K * 15 + I + J - K)
If mun < 6 Then Gen = Gen + mun * 2 ^ mun
If mun > 5 And mun Mod 6 = 0 Then mun = mun \ 6 - 1: Gen = Gen - mun * 2 ^ mun
RL(K * 15 + I + J - K) = RL(K * 15 + I + J - K) + Piece
mun = RL(K * 15 + I + J - K)
If mun < 6 Then Gen = Gen - mun * 2 ^ mun
If mun > 5 And mun Mod 6 = 0 Then mun = mun \ 6 - 1: Gen = Gen + mun * 2 ^ mun
Next K

'捺线影响
b = IIf(I - 4 > 0, I - 4, 0)
e = IIf(I > 10, 10, I)
b = IIf(b > I - J + IIf(J - 4 > 0, J - 4, 0), b, I - J + IIf(J - 4 > 0, J - 4, 0))
e = IIf(e > I - J + IIf(J > 10, 10, J), I - J + IIf(J > 10, 10, J), e)
For K = b To e
mun = LR(K * 15 - I + J + K)
If mun < 6 Then Gen = Gen + mun * 2 ^ mun
If mun > 5 And mun Mod 6 = 0 Then mun = mun \ 6 - 1: Gen = Gen - mun * 2 ^ mun
LR(K * 15 - I + J + K) = LR(K * 15 - I + J + K) + Piece
mun = LR(K * 15 - I + J + K)
If mun < 6 Then Gen = Gen - mun * 2 ^ mun
If mun > 5 And mun Mod 6 = 0 Then mun = mun \ 6 - 1: Gen = Gen + mun * 2 ^ mun
Next K
End Function

'是否存在三子一线（可发展成五子联线）
Function linethree(Piece As Integer) As Integer
Dim mun As Integer
linethree = 225
'三子一线
mun = Piece * 3
For I = 0 To 224
If H(I) = mun Then
If Grid(I) = 0 Then
If I Mod 15 < 10 Then
If Grid(I + 5) = 0 Then
For K = 1 To 4
If Grid(I + K) = 0 Then
Tb(0) = I + K
Tb(1) = I
Tb(2) = I + 5
linethree = Tb(0)
Exit Function
End If
Next K
End If
End If
End If
End If

If V(I) = mun Then
If Grid(I) = 0 Then
If (I \ 15) < 10 Then
If Grid(I + 75) = 0 Then
For K = 1 To 4
If Grid(I + K * 15) = 0 Then
Tb(0) = I + K * 15
Tb(1) = I
Tb(2) = I + 75
linethree = Tb(0)
Exit Function
End If
Next K
End If
End If
End If
End If

If RL(I) = mun Then
If Grid(I) = 0 Then
If (I \ 15) < 10 And I Mod 15 > 4 Then
If Grid(I + 70) = 0 Then
For K = 1 To 4
If Grid(I + K * 14) = 0 Then
Tb(0) = I + K * 14
Tb(1) = I
Tb(2) = I + 70
linethree = Tb(0)
Exit Function
End If
Next K
End If
End If
End If
End If

If LR(I) = mun Then
If Grid(I) = 0 Then
If (I \ 15) < 10 And I Mod 15 < 10 Then
If Grid(I + 80) = 0 Then
For K = 1 To 4
If Grid(I + K * 16) = 0 Then
Tb(0) = I + K * 16
Tb(1) = I
Tb(2) = I + 80
linethree = Tb(0)
Exit Function
End If
Next K
End If
End If
End If
End If
Next I
End Function

Private Sub munHelp_Click() '帮助
lblHelp.Visible = True
End Sub

代码狂人