End If
LBlock(ArrNum) = LB: RBlock(ArrNum) = RB: Value = IIf(EmptyNum = 0, 5 ^ PieceNum, 5 ^ PieceNum - 5 ^ EmptyNum)
EmptyNumE(ArrNum) = EmptyNum
'左右状态赋值给其相应的记录数组;并将分值赋给相应记分数组
ScoreE(ArrNum) = IIf(RB, IIf(LB, 1, Value / 2), IIf(LB, Value / 2, Value))
JudgeLineNum = PieceNum '返回最大共线子数
End Function
在单线棋形判断函数的基础上,可评估某点综合棋局情况时多重方向上的棋形叠加。如前所述,用冒泡排序法选出两种最优单线棋形得分;这样做在不改变程序核心的权重估值算法的前提下很大程度上提高了程序执行效率。以下为多线棋形评估函数:
Public Function DoGen(ByRef PieceTar() As Integer, ByVal Xt%, ByVal Yt%, ByVal Flag As Byte) '棋局综合情况评估函数
PieceNum(1) = JudgeLineNum(Piece, Xt, Yt, 1, 0, 1, Flag)
'在调用函数进行数组赋值时可以同时进行返回值处理
PieceNum(2) = JudgeLineNum(Piece, Xt, Yt, 1, 1, 2, Flag)
PieceNum(3) = JudgeLineNum(Piece, Xt, Yt, 0, 1, 3, Flag)
PieceNum(4) = JudgeLineNum(Piece, Xt, Yt, -1, 1, 4, Flag)
Call ArraySort(ScoreE, PieceNum, EmptyNumE, LBlock, RBlock)
'调用数组排序函数对得分数组进行排序
If (LBlock(1) = False And RBlock(1) = False) And (LBlock(2) = False And LBlock(2) = False) And PieceNum(1) = 4 And PieceNum(2) = 4 Then _
DoGen = FFDL: Exit Function '如果双活四则返回双活四得分
If ((LBlock(2) = False And RBlock(2) = True) Or (LBlock(2) = True And RBlock(2) = False)) And (LBlock(1) = False And RBlock(1) = False) And PieceNum(1) = 4 _
And PieceNum(2) = 4 Then DoGen = FFSL: Exit Function '返回成四与活四得分
If (LBlock(1) = False And RBlock(1) = False) And (LBlock(2) = False And RBlock(2) = False) And PieceNum(1) = 4 And PieceNum(2) = 3 Then _
DoGen = FTDL: Exit Function '返回活四活三得分
If ((LBlock(1) = False And RBlock(1) = True) Or (LBlock(1) = True And RBlock(1) = False)) And ((LBlock(2) = False And RBlock(2) = True) Or (LBlock(2) = True _
And RBlock(2) = False)) And PieceNum(1) = 4 And PieceNum(2) = 4 Then DoGen = FFNL: Exit Function '返回双成四得分
If (LBlock(1) = False And RBlock(1) = False) And PieceNum(1) = 4 Then DoGen = FL - IIf(EmptyNumE(1) = 0, 0, 5 ^ EmptyNumE(1)): Exit Function '返回单活四或跳成四得分
If ((LBlock(1) = True And RBlock(1) = False) Or (LBlock(1) = False And RBlock(1) = True)) And PieceNum(1) = 4 And (LBlock(2) = False And RBlock(2) = False) _
And PieceNum(2) = 3 Then DoGen = FTSL: Exit Function '返回成四活三得分
If (LBlock(1) = False And RBlock(1) = False) And (LBlock(2) = False And RBlock(2) = False) And PieceNum(1) = 3 And PieceNum(2) = 3 Then _
DoGen = TTDL: Exit Function '返回双活三得分
DoGen = ScoreE(1) + ScoreE(2) '其余情况返回两向得分之和
End Function
在局面估值函数的基础之上,利用一个二重循环来扫描整个棋盘空闲位置,并在各位置分别用己方和对方子力估值求出两个权重指数。分别乘以两个权重系数,我们称之为攻防系数。这就为算法执行效果的拓展提供了理论依据。比如,简单地以参数的形式修改权重系数而不修改算法,就可以使电脑具备冒进、稳健、保守等多种截然不同的下棋风格。实践也证明,在估值函数与局面评估函数完全相同的条件下,攻防系数的不同可以产生完全不同的走法。以下是返回当前最重要棋步的函数:
Public Function GetVitalStep(ByRef PieceTar() As Integer, ByRef ScoreTar%, ByVal Flag As Byte) As Integer '返回当前下子方最重要棋步
Dim i%, j%, t%, r%: Dim FlagX As Byte: FlagX = IIf(Flag = 1, 2, 1)
For i = 1 To 15 '扫描棋盘看有无己方胜利的位置
For j = 1 To 15
If PieceTar(i, j) = 0 Then
PieceTar(i, j) = Flag
If JudgeWinner(PieceTar, i, j, Flag) = True Then GetVitalStep = i + (j - 1) * 15: PieceTar(i, j) = 0: ScoreTar = Five: Exit Function
PieceTar(i, j) = 0
End If
Next j
Next i
For i = 1 To 15 '看对方有无胜利的位置
For j = 1 To 15
If PieceTar(i, j) = 0 Then
PieceTar(i, j) = FlagX
If JudgeWinner(PieceTar, i, j, FlagX) = True Then GetVitalStep = i + (j - 1) * 15: PieceTar(i, j) = 0: ScoreTar = Five: Exit Function
PieceTar(i, j) = 0
End If
Next j
Next i
For i = 1 To 15 '扫描己方活四棋形
For j = 1 To 15
If PieceTar(i, j) = 0 Then
t = DoGen(PieceTar, i, j, Flag)
If t = FFDL Then GetVitalStep = i + (j - 1) * 15: ScoreTar = FFDL: Exit Function
If t = FFSL Then GetVitalStep = i + (j - 1) * 15: ScoreTar = FFSL: Exit Function
If t = FTDL Then GetVitalStep = i + (j - 1) * 15: ScoreTar = FTDL: Exit Function
If t = FL Then GetVitalStep = i + (j - 1) * 15: ScoreTar = FL: Exit Function
End If
Next j
Next i
For i = 1 To 15 '扫描己方成四伴随棋形
For j = 1 To 15
If PieceTar(i, j) = 0 Then
t = DoGen(PieceTar, i, j, Flag)
If t = FTSL Then GetVitalStep = i + (j - 1) * 15: ScoreTar = FTSL: Exit Function
If t = FFNL Then GetVitalStep = i + (j - 1) * 15: ScoreTar = FFNL: Exit Function
End If
Next j
Next i
For i = 1 To 15 '扫描对方活四伴随棋形
For j = 1 To 15
If PieceTar(i, j) = 0 Then
t = DoGen(PieceTar, i, j, FlagX)
If t = FFDL Then GetVitalStep = i + (j - 1) * 15: Exit Function
If t = FTDL Then GetVitalStep = i + (j - 1) * 15: ScoreTar = FTDL: Exit Function
If t = FFSL Then GetVitalStep = i + (j - 1) * 15: ScoreTar = FFSL: Exit Function
If t = FL Then GetVitalStep = i + (j - 1) * 15: ScoreTar = FL: Exit Function
End If
Next j
Next i
For i = 1 To 15 '扫描己方成四伴随棋形
For j = 1 To 15
If PieceTar(i, j) = 0 Then
t = DoGen(PieceTar, i, j, Flag)
If t = FTSL Then GetVitalStep = i + (j - 1) * 15: ScoreTar = FTSL: Exit Function
If t = FFNL Then GetVitalStep = i + (j - 1) * 15: ScoreTar = FFNL: Exit Function
End If
Next j
Next i
For i = 1 To 15 '扫描己方双活三棋形
For j = 1 To 15
If PieceTar(i, j) = 0 Then
t = DoGen(PieceTar, i, j, Flag)
If t = TTDL Then GetVitalStep = i + (j - 1) * 15: ScoreTar = TTDL: Exit Function
End If
Next j
Next i
For i = 1 To 15 '扫描对方双活三棋形
For j = 1 To 15
If PieceTar(i, j) = 0 Then
t = DoGen(PieceTar, i, j, FlagX)
If t = TTDL Then GetVitalStep = i + (j - 1) * 15: ScoreTar = TTDL: Exit Function
End If
Next j
Next i
Dim iMax%, jMax%, max%: max = 0 '若前面的棋形均无则自动取得分函数计算最大值点作为落子点
For i = 1 To 15
For j = 1 To 15
If PieceTar(i, j) = 0 Then
t = DoGen(PieceTar, i, j, Flag)
r = DoGen(PieceTar, i, j, FlagX)
If t + r > max Then
max = t + r: iMax = i: jMax = j
End If
PieceTar(i, j) = 0
End If
Next j
Next i
ScoreTar = max: GetVitalStep = iMax + (jMax - 1) * 15
End Function
Public Function Swap(ByRef Val1 As Variant, ByRef Val2 As Variant)
’传址变量交换函数,在排序中会用到
Dim t As Variant
t = Val1: Val1 = Val2: Val2 = t
End Function
到此为止,电脑AI的设计就告一段落。程序还应具备基本的写出棋谱的能力,并应尽可能的模块化。写棋谱函数的返回值为布尔型,写出为真;反之为假。文件结构由于其有序性而采用顺序文件结构。棋谱文件中每一项记录的组成:[横坐标][纵坐标][玩家标记]。棋盘的长宽是大于十的,因而我们采用十六进制数来表示棋盘坐标。在悔棋记录数组的基础之上,可利用其方便地实现棋谱的文件化输出。实现代码如下:
Public Function WriteChessManual(ByVal FileName As String, ByRef PieceTar() As Integer) As Boolean '写出文件成功返回真,取消或失败返回假
Dim FileNum%, i%, j%: Dim tmpx$, tmpy$
i = 0: WriteChessManual = False '用来保存棋局信息
Open FileName For Output As #1
Do While i < SearchNode(PieceRec)
i = i + 1
tmpx = DToH(Val(IIf(PieceRec(i) Mod 15 = 0, 15, PieceRec(i) Mod 15))): tmpy = DToH(Val(IIf(PieceRec(i) \ 15 = 0, PieceRec(i) \ 15, PieceRec(i) \ 15 + 1)))
Print #1, tmpx; tmpy; IIf(i Mod 2 = 0, 2, 1)
Loop
Close #1 '关闭文件并将缓存中内容写到硬盘
WriteChessManual = True
End Function
与写棋谱函数对应,参数与写棋谱函数相同。
Public Function ReadChessManual(ByVal FileName As String, ByRef PieceTar() As Integer) As Boolean '用户取消或失败返回假
Dim i%, j%, S$, tmpx%, tmpy%, Flag As Byte: ReadChessManual = False
Open FileName For Input As #1
Do While Not EOF(1)
Line Input #1, S
For i = 1 To Len(S)
If Mid(S, i, 1) <> " " Then
j = j + 1
Select Case j
Case 1
tmpx = HToD(Mid(S, i, 1))
Case 2
tmpy = HToD(Mid(S, i, 1))
Case 3
Flag = HToD(Mid(S, i, 1))
End Select
End If
Next i
LayPiece Piece, tmpx, tmpy, Flag
DrawPiece Form1, tmpx, tmpy, Flag
j = 0
Loop
Close #1 '文件打开后要关闭以释放缓存
GameOrNot = True: ActiveDisp Form1.mnuModeAI, Form1.mnuModeDouble, AIOrNot
Form1.mnuFileEndCurrentGame.Enabled = True
ReadChessManual = True
End Function
在调用数组复制命令时需要用到的数组复制函数:
Public Function ArraySort(ByRef ArrayTarget1() As Integer, ByRef ArrayTarget2() As Byte, ByRef ArrayTarget3() As Byte, ByRef ArrayTarget4() As Boolean, ByRef ArrayTarget5() As Boolean)
'目标数组递减排序函数
Dim i%, j%, t%
For i = 1 To 3
For j = 1 To 4 - i
If ArrayTarget1(j + 1) > ArrayTarget1(j) Then '用冒泡法进行递减排序
Swap ArrayTarget1(j + 1), ArrayTarget1(j)
Swap ArrayTarget2(j + 1), ArrayTarget2(j)
Swap ArrayTarget3(j + 1), ArrayTarget3(j)
Swap ArrayTarget4(j + 1), ArrayTarget4(j)
Swap ArrayTarget5(j + 1), ArrayTarget5(j)
End If
Next j
Next i
End Function
在棋步存取时需要用到的两个进制转换函数:
Public Function DToH(ByVal SourceNum%) As String
'十进制到十六进制转换函数,用于写出棋谱函数的调用
Dim i%, j%, S$, t$: S = ""
i = SourceNum
Do While i Mod 16 > 0
j = i Mod 16
Select Case j
Case 0 To 9
t = CStr(j)
Case 10 To 15
t = Chr(Asc("A") + j - 10)
End Select
S = t + S
i = i \ 16
Loop
DToH = S
End Function
Public Function HToD(ByVal SourceNum$) As Integer
'十六进制到十进制转换函数,用于读入棋谱函数的调用
Dim i%, j%, t%, S$
For i = 1 To Len(SourceNum)
S = Mid(SourceNum, i, 1)
Select Case S
Case "0" To "9"
t = Val(S)
Case "A" To "F"
t = Asc(S) - Asc("A") + 10
End Select
j = j * 16 + t
Next i
HToD = j
End Function
可以用一个小巧的函数让通用对话框空间更容易使用。只要保证每次打开通用对话框后清空文件名,就能根据文件名是否为空判断用户是否选择了取消操作。
Public Function OpenDialog(ByRef TarDialog As CommonDialog, ByVal Action As Byte) As Boolean
'如果成功返回非空文件名则返回真;OpenMode与通用对话框本身的Action属性相同
TarDialog.Action = Action
If TarDialog.FileName <> "" Then OpenDialog = True Else OpenDialog = False
End Function
程序运行效果如图2所示。
图2 程序运行效果
五、结语
权重估值算法本身的特点,使程序在智力不低的基础上有了不错的反应速度。算法流程中未加入递归预测,主要原因是权重估值时我们利用了得分无穷小的近似计算,但以此为依据递归并不能用归纳法推证,使其所算分值不一定接近事实;即使在特殊情况下恰巧满足了归纳法的条件,也会因为得分无穷小的存在而使递归预测所得电脑智力的提高受到限制。总的来说,本文为VB编程环境下五子棋的完整实现提供了较为详实的参考,也为五子棋在权重估值算法上的可行性与效果提供了一定的理论依据。
|