[讨论]三子棋之人工智能的实现(已完工)

彭希仁

当我还是小屁孩(穿开档裤)的时候就会下棋了,就今天我要介绍给大家的三子棋.棋盘为3*3的格子,最先连成斜三点一线的一方胜.由于走法简单现拿出来给大家分享一下,同时也希望各位能动动脑子,想想该如何实现人工智能?

WmBEk5AW.rar (56.35 KB, 下载次数: 275)

2007-11-28 16:12 上传

点击文件名下载附件
[讨论]三子棋之人工智能的实现(已完工)

[此贴子已经被作者于2007-11-28 16:14:40编辑过]

[ 本帖最后由 彭希仁 于 2009-7-12 12:48 编辑 ]

彭希仁

基本思路是这样的.

第一步:选让棋子动起来,即每个棋子都有一个对应的坐标(棋盘),

第二步:评分机制,分为三种1(胜),0(平),-1(输)

第三步,关键算法

         即:穷举第一种走法之后,将用调用递归轮到对方走棋,以对方最好的一步棋,取反做为本次走法的得分.(即对方走胜了,也就是本方输了)

            穷举第二种走法之后,将用调用递归轮到对方走棋,以对方最好的一步棋,取反做为本次走法的得分.

            穷举N种走法之后,找出这些最高评分的一次走法.

如此反复的递归,就可实现人工智能.递归的深度越深智能越高,当然这也要付出相就的代价,即时间越长,所以得选择合适的递归深度.

[此贴子已经被作者于2007-11-16 8:08:31编辑过]

northwolves

严重关注此贴进展

wsri

我也拿个板凳来学习学习！

winland

这个就是那个Tic-Tac游戏吧，网上好多例子了。

shi_99

对于人工智能我一直很有兴趣，但却一直不得其门而入。

BobPan

有趣，现在开始研究，希望能出成品

彭希仁

QUOTE:

晚上有空点写了一点点,明天继续

QUOTE:

 第一步,初始化工作,可选择并移动蓝色棋子

QUOTE:

Public arr, a
Private Sub Image8_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    For i = 1 To 3
        For ii = 1 To 3
            If X > arr(i, ii, 2) And X < arr(i, ii, 2) + 100 And Y > arr(i, ii, 3) And Y < arr(i, ii, 3) + 100 Then
                If arr(i, ii, 4) = -1 Then
                    If a <> 0 Then
                        Me.Controls(a).SpecialEffect = fmSpecialEffectFlat   '重选棋子
                        a = arr(i, ii, 1)
                        Me.Controls(a).SpecialEffect = fmSpecialEffectBump
                    Else
                        a = arr(i, ii, 1)
                        Me.Controls(a).SpecialEffect = fmSpecialEffectBump

                    End If
                End If
                If arr(i, ii, 4) = 0 And a <> 0 Then
                       For iii = 1 To 3
                            For iiii = 1 To 3
                                If arr(iii, iiii, 1) = a Then
                                    X = iii
                                    Y = iiii
                                End If
                            Next iiii
                        Next iii
                        If X = i And Y = ii Then Exit Sub
                        If Abs(X - i) > 1 Or Abs(Y - ii) > 1 Then Exit Sub
                        Call 移动棋子(X, Y, i, ii)
                End If
            End If
        Next ii
    Next i
End Sub

Private Sub UserForm_Activate()
    Call 初始化_Click
End Sub

Private Sub 初始化_Click()
    Dim i As Long
    Dim ii As Long
    行宽 = 122
    列宽 = 122
    ReDim arr(0 To 4, 0 To 4, 1 To 4)    '分别记录棋子图片控件名称，位置
    For i = 1 To 3                '位置
        For ii = 1 To 3
            arr(i, ii, 2) = 20 + (ii - 1) * 行宽
            arr(i, ii, 3) = 25 + (i - 1) * 列宽
        Next ii
    Next i
    '将棋子图片名称载入数组
    arr(1, 1, 1) = "Image2"
    arr(1, 2, 1) = "Image3"
    arr(1, 3, 1) = "Image4"
    arr(3, 1, 1) = "Image5"
    arr(3, 2, 1) = "Image6"
    arr(3, 3, 1) = "Image7"
    '1代表蓝色棋子,-1代表黑化棋子
    arr(1, 1, 4) = 1
    arr(1, 2, 4) = 1
    arr(1, 3, 4) = 1
    arr(3, 1, 4) = -1
    arr(3, 2, 4) = -1
    arr(3, 3, 4) = -1
    For i = 1 To 3
        For ii = 1 To 3
            If arr(i, ii, 1) <> "" Then
                Me.Controls(arr(i, ii, 1)).Left = arr(i, ii, 2)
                Me.Controls(arr(i, ii, 1)).Top = arr(i, ii, 3)
                Me.Controls(arr(i, ii, 1)).SpecialEffect = fmSpecialEffectFlat
            End If
        Next ii
    Next i
End Sub
Sub 移动棋子(X, Y, xx, yy)
    a = arr(X, Y, 1)
    arr(xx, yy, 1) = arr(X, Y, 1)
    arr(xx, yy, 4) = arr(X, Y, 4)
    Me.Controls(a).Left = arr(xx, yy, 2)
    Me.Controls(a).Top = arr(xx, yy, 3)
    arr(X, Y, 1) = 0
    arr(X, Y, 4) = 0
    Me.Controls(a).SpecialEffect = fmSpecialEffectFlat
    a = 0
End Sub

1vSrjcI6.rar (50.4 KB, 下载次数: 51)

2007-11-27 23:20 上传

点击文件名下载附件

[此贴子已经被作者于2007-11-27 23:22:59编辑过]

lj1226189

论坛上高手如云!但彭兄绝对是高手中的高手!

关注此帖!

彭希仁

 

'已完工,以下就是电脑思考部分的代码

Public arr, a
Sub 电脑走棋()
    Dim arr1
    ReDim arr1(1 To 3, 1 To 3)
    Dim z
    For i = 1 To 3
        For j = 1 To 3
            arr1(i, j) = arr(i, j, 4)
        Next j
    Next i
    If (arr1(1, 1) = -1 And arr1(2, 2) = -1 And arr1(3, 3) = -1) Or (arr1(1, 3) = -1 And arr1(2, 2) = -1 And arr1(3, 1) = -1) Then
        MsgBox "认输": Exit Sub
    End If
    Call 人工智能(arr1, z, 1)

    For i = 1 To 3
        For j = 1 To 3
            If arr1(i, j) = 0 And arr(i, j, 4) = 1 Then
                X = i
                Y = j
                UserForm1.Controls(arr(i, j, 1)).SpecialEffect = fmSpecialEffectFlat
            End If
            If arr1(i, j) = 1 And arr(i, j, 4) = 0 Then
                xx = i
                yy = j
            End If
        Next j
    Next i
    If (X = i And Y = ii) Or z < 0 Then MsgBox "认输": Exit Sub
    If X = 0 Or Y = 0 Or xx = 0 Or yy = 0 Then Exit Sub
    a = arr(X, Y, 1)
    arr(xx, yy, 1) = arr(X, Y, 1)
    arr(xx, yy, 4) = arr(X, Y, 4)
    UserForm1.Controls(a).Left = arr(xx, yy, 2)
    UserForm1.Controls(a).Top = arr(xx, yy, 3)
    arr(X, Y, 1) = 0
    arr(X, Y, 4) = 0
    UserForm1.Controls(a).SpecialEffect = fmSpecialEffectFlat
    a = 0
    If (arr1(1, 1) = 1 And arr1(2, 2) = 1 And arr1(3, 3) = 1) Or (arr1(1, 3) = 1 And arr1(2, 2) = 1 And arr1(3, 1) = 1) Then
        MsgBox "电脑胜"
    End If
End Sub

Sub 人工智能(arr1, z, s)
    If s = 5 Then
        z = 0
        Exit Sub
    End If
    arr3 = arr1
    Dim aar2
    Dim zz
    z = -1

    For i = 1 To 3
        For j = 1 To 3
            For ii = 1 To 3
                For jj = 1 To 3
                    If arr1(i, j) = 1 And arr1(ii, jj) = 0 Then
                        If Abs(ii - i) < 2 And Abs(jj - j) < 2 Then
                            If Abs(ii - i) * Abs(jj - j) = 0 Or (i = 2 And j = 2) Or (ii = 2 And jj = 2) Then
                                arr2 = arr1
                                arr2(ii, jj) = arr2(i, j)
                                arr2(i, j) = 0
                                '判断是否三子连线
                                If (arr2(1, 1) = 1 And arr2(2, 2) = 1 And arr2(3, 3) = 1) Or (arr2(1, 3) = 1 And arr2(2, 2) = 1 And arr2(3, 1) = 1) Then
                                    arr1 = arr2
                                    z = 1              '胜了,记录走法并返回
                                    Exit Sub
                                End If

                                For iii = 1 To 3                 '交换角色,换对方走棋
                                    For jjj = 1 To 3
                                        arr2(iii, jjj) = arr2(iii, jjj) * -1
                                    Next jjj
                                Next iii
                                Call 人工智能(arr2, zz, s + 1)
                            If zz * -1 > z Or (zz * -1 = z And Rnd > 0.3) 'ZZ返回的是对方最好的走法的得分,*-1之后就可以做得这次走法的得分,即对方胜了,就是自已输了.
                                    z = zz * -1                 '将最高得分记录下来
                                    arr3 = arr1                 '将最高得分的走法记录下来
                                    arr3(ii, jj) = arr3(i, j)
                                    arr3(i, j) = 0
                                End If
                            End If
                        End If
                    End If
                Next jj
            Next ii
        Next j
    Next i
    arr1 = arr3
End Sub

[此贴子已经被作者于2007-11-28 16:15:55编辑过]