你好,欢迎来到电脑编程技巧与维护杂志社! 杂志社简介广告服务读者反馈编程社区  
合订本订阅
 
 
您的位置:杂志经典 / 图形图象处理与游戏编程
5.2 五子棋人工智能权重估值算法(下)
 

  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编程环境下五子棋的完整实现提供了较为详实的参考,也为五子棋在权重估值算法上的可行性与效果提供了一定的理论依据。

  推荐精品文章

·2024年9月目录 
·2024年8月目录 
·2024年7月目录 
·2024年6月目录 
·2024年5月目录 
·2024年4月目录 
·2024年3月目录 
·2024年2月目录 
·2024年1月目录
·2023年12月目录
·2023年11月目录
·2023年10月目录
·2023年9月目录 
·2023年8月目录 

  联系方式
TEL:010-82561037
Fax: 010-82561614
QQ: 100164630
Mail:gaojian@comprg.com.cn

  友情链接
 
Copyright 2001-2010, www.comprg.com.cn, All Rights Reserved
京ICP备14022230号-1,电话/传真:010-82561037 82561614 ,Mail:gaojian@comprg.com.cn
地址:北京市海淀区远大路20号宝蓝大厦E座704,邮编:100089