【五子棋AI循序渐进】发布一个完整的有一定棋力的版本（含源码）
经过这半年左右的学习和探索，现在对五子棋AI有了一定的认识，给大家发出来现在的版本。因为最近有些事情很生气，要是年轻时真就先灭了这些王八羔子，省的它们继续祸害好人。不过它们也祸害不了几天了，祸害人者人祸害之。心情不好，就少打几个字，说一下基本思路：
1、每一个点的重要性，决定于四个方向上的棋型；棋型是可以相互转化的，可以枚举出每一种变化以及它们之间的关联关系。
例如：（0=白、1=黑、2=空，程序中和下面全文均如此）
一行空棋 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 当白棋要下的时候，就要考察更好的点，我们如果给这一行棋评分如下
0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 那么，白棋的走法生成器就会知道1的那些点，排在0前面。同样道理，
一行棋型 2 2 2 1 1 1 2 2 2 2 2 2 2 2 2 2 当白棋要下的时候，就会选择分数更高的点先进行测试：
2 4 8 -1 -1 -1 8 4 2 1 1 1 1 1 1 0 于是会先测试8分，然后4分，然后2分1分，当然，因为8分点已经可以导致胜利（活4）那么可以不生成其他点。而此时如果我们下在第3个位置上，即第一个评分为8的点上，则得到棋型：
一行棋型 2 2 1 1 1 1 2 2 2 2 2 2 2 2 2 2 对这个棋型的评分我们也可以预先评价好：
4 F -1 -1 -1 -1 F 4 2 1 1 1 1 1 1 0
所以，我们可以建立一个结构数组来保存棋型及其对应的各个点的冲棋值，这样很容易得到下某一个点后的新棋盘评价。
2、VCT\VCF。这个话题可以说是五子棋中非常重要的，可以说一个AI的VCT\VCF能力体现了它的棋力（呵呵，不过我的现在还不怎么样）。我没有看到这方面的源码，但实际上，VCN搜索无非是象棋中的“将军延伸”技术而已！虽然我的代码中我进行了一些修改而且看起来不伦不类（因为没有详细的记录每一方的冲棋程度），但我在网上搜索时经常看到有人问你的VCT,VCF做的怎么样了？我就很茫然的说……
3、走法顺序。这确实是一个非常值得深入思考的问题，但是从冲棋点的角度来考虑，这似乎不是问题，我们完全可以根据冲棋点分值大小进行排列，可实际上代码会很长，至少我的程序里面它是仅次于剪裁函数的家伙，而且我对那些代码很不满意。
好了，贴上一些核心代码，说明一下：
Public Class mShape529 Public tShapeObj() As mShape529 '转换结果的引用 Public cLine() As mConstValue.LinkType '冲棋信息（由空点决定） Sub New(len As Integer) ReDim tShapeObj(len * 3 - 1) ReDim cLine(len * 2 - 1) End Sub Public Overrides Function ToString() As String Dim tmp As String = String.Empty For i As Integer = 0 To cLine.Length - 1 tmp &= cLine(i).ToString & " " If i + 1 = cLine.Length \ 2 Then tmp &= " | " Next Return tmp End Function End Class Public Class mShapeManeger Private Shared allShapes(4) As List(Of mShape529) '长度为len的全部形态 Shared Sub New() Dim i As Integer For i = 0 To 4 allShapes(i) = New List(Of mShape529) allShapes(i) = ReadByteFile59(i + 5) Next End Sub '返回指定长度的模板 Public Shared ReadOnly Property ShapeList(len As Integer) As List(Of mShape529) Get Return allShapes(IIf(len > 9, 4, len - 5)) End Get End Property Private Shared Function ReadByteFile59(len As Integer) As List(Of mShape529) ' tShape() As Integer 'len*3*2 ' cLine() As byte 'len*2 Dim bytes() As Byte = My.Resources.ResourceManager.GetObject("_" & len) Dim i, j, l As Integer, tmps(1) As Byte Dim ret As New List(Of mShape529) Dim stp As Integer = len * 3 * 2 + len * 2 Dim tmpint As Integer For i = 0 To bytes.Length - 1 Step stp ret.Add(New mShape529(len)) Next For i = 0 To ret.Count - 1 Dim tmp = ret(i) For j = 0 To len * 3 - 1 tmps(0) = bytes(l) tmps(1) = bytes(l + 1) l += 2 tmpint = CInt(BitConverter.ToInt16(tmps, 0)) If tmpint <> -1 Then tmp.tShapeObj(j) = ret(tmpint) Next For j = 0 To len * 2 - 1 Select Case bytes(l) Case 0 tmp.cLine(j) = mConstValue.LinkTypelnl Case 1 tmp.cLine(j) = mConstValue.LinkTypel00 Case 2 tmp.cLine(j) = mConstValue.LinkTypel11 Case 3 tmp.cLine(j) = mConstValue.LinkTypel12 Case 4 tmp.cLine(j) = mConstValue.LinkTypel21 Case 5 tmp.cLine(j) = mConstValue.LinkTypel22 Case 6 tmp.cLine(j) = mConstValue.LinkTypel31 Case 7 tmp.cLine(j) = mConstValue.LinkTypel32 Case 8 tmp.cLine(j) = mConstValue.LinkTypel32 Case 9 tmp.cLine(j) = mConstValue.LinkTypel41 Case 10 tmp.cLine(j) = mConstValue.LinkTypel415 Case 11 tmp.cLine(j) = mConstValue.LinkTypel42 Case 12 tmp.cLine(j) = mConstValue.LinkTypel50 Case 13 tmp.cLine(j) = mConstValue.LinkTypel60 Case 14 tmp.cLine(j) = mConstValue.LinkTypel70 End Select l += 1 Next ret(i) = tmp Next Return ret End Function End Class
上面是基础形态和基础形态管理器，思路是5-14长度的72个向量中，5-9长度的，直接使用生成好的模板，而10-14的，利用9长度的模板进行合成。因为这是初始化时的代码不影响计算速度，所以没有任何优化。
Public Class mVector52E Private mss As List(Of mShape529) '当前形态模板 Public len As Byte '向量长度 Public shapes() As mShape529 '所包含的形态 Public cLine() As Integer '冲棋信息 Public key As Integer '键。由低20-30位记录形态。同一位置用2位表示，白棋在低位黑棋在高位。没有初始化的必要。 Private ps() As Byte '包含的棋盘点（实际坐标）。 Private dx, dy As Integer '方向:右=(1,0),下=(0,1),右上=(1,-1),左上=(-1,-1) Sub New(points() As Byte, xoffset As Integer, yoffset As Integer) Dim i As Integer len = points.Length ReDim ps(len - 1) Array.Copy(points, ps, len) dx = xoffset dy = yoffset '本向量对应的形态模板 mss = mShapeManeger.ShapeList(len) '定义冲棋信息 ReDim cLine(len * 2 - 1) '若长度为9以内，则用一个长度相等的形态表示即可。否则用一组长度为9的形态表示。 If len <= 9 Then ReDim shapes(0) shapes(0) = mss(0) Else ReDim shapes(len - 9) For i = 0 To shapes.Length - 1 shapes(i) = mss(0) Next End If End Sub Sub SetPlayer(point As Byte, player As Integer) Dim i, j, p As Integer, tkm, tks As Integer Dim n As Integer = Math.Min(len - 1, 8) '最大下标 Dim ts As mShape529 '更新所属形态 For i = 0 To shapes.Length - 1 p = point - i '当点在需要更新的形态内 If p > -1 AndAlso p <= n Then ts = shapes(i).tShapeObj(3 * p + player) If ts Is Nothing Then Throw New Exception("该点已经有子") Else shapes(i) = ts End If End If Next '更新key和检查置换表。 Dim keyindex As Integer = (point - 2) * 2 If player = 2 Then key = key And Not (1 << keyindex) '删除白棋 key = key And Not (1 << keyindex + 1) '删除黑棋 Else key = key Or (1 << keyindex + player) '设置棋子 End If If len > 9 AndAlso mZobristForVector.ProbeHash(Me) Then Return '清理冲棋信息 For i = 0 To len * 2 - 1 cLine(i) = 0 Next '由子形态合成向量冲棋信息 For i = 0 To shapes.Length - 1 ts = shapes(i) For j = 0 To n tkm = cLine(j + i) tks = ts.cLine(j) If tks > tkm OrElse tks = mConstValue.LinkTypelnl OrElse tks = mConstValue.LinkTypel70 Then cLine(j + i) = tks tkm = cLine(j + i + len) tks = ts.cLine(j + n + 1) If tks > tkm OrElse tks = mConstValue.LinkTypelnl OrElse tks = mConstValue.LinkTypel70 Then cLine(j + i + len) = tks Next Next '保存到置换表 If len > 9 Then mZobristForVector.RecordHash(Me) End Sub Function InLine(p As Byte) As Boolean Dim i As Integer For i = 0 To ps.Length - 1 If ps(i) = CByte(p) Then Return True Next Return False End Function Sub Clear() Dim i As Integer key = 0 For i = 0 To shapes.Length - 1 shapes(i) = mss(0) Next End Sub Public Function BoardPoint2VectorPoint(p As Byte) As Byte '右=(1,0),下=(0,1),右上=(1,-1),左上=(-1,-1) If dy = 0 Then '右 '0 1 2 3 4 5 …… 14 '1 2 3 4 5 6 …… 15 Return p - ps(0) End If If dx = 0 Then '下 ' 0 15 30 45 ' 1 16 31 46 Return (p - ps(0)) / 15 End If If dx = 1 Then '右上 '60 46 32 18 4 '75 61 47 33 19 5 Return (ps(0) - p) / 14 End If If dx = -1 Then '左上 '214 198 182 166 150 '209 193 177 161 Return (ps(0) - p) / 16 End If Throw New Exception("err") End Function Public Function VectorPoint2BoardPoint(p As Byte) As Byte '右=(1,0),下=(0,1),右上=(1,-1),左上=(-1,-1) If dy = 0 Then '右 '0 1 2 3 4 5 …… 14 '1 2 3 4 5 6 …… 15 Return p + ps(0) End If If dx = 0 Then '下 ' 0 15 30 45 ' 1 16 31 46 Return p * 15 + ps(0) End If If dx = 1 Then '右上 '60 46 32 18 4 '75 61 47 33 19 5 Return ps(0) - p * 14 End If If dx = -1 Then '左上 '214 198 182 166 150 '209 193 177 161 Return ps(0) - p * 16 End If Throw New Exception("err") End Function Public Overrides Function ToString() As String Dim tmp As String = String.Empty For i As Integer = 0 To len * 2 - 1 tmp &= ps(i) & Space(6 - cLine(i).ToString.Length) & cLine(i) & vbCrLf Next Return tmp End Function End Class Public Class mVectorManager '所有行 Public AllVectors(71) As mVector52E '点对应的行 Public VectorsOfPoint(224)() As mVector52E Sub New() '求所有的向量 Dim x, y, n, levindex As Integer Dim lev(4) As Integer '右,0-14 For y = 0 To 14 AllVectors(n) = GetVector(0, y, 14, y, 1, 0) n += 1 Next levindex += 1 lev(levindex) = n '下 For x = 0 To 14 AllVectors(n) = GetVector(x, 0, x, 14, 0, 1) n += 1 Next levindex += 1 lev(levindex) = n '右上 For y = 4 To 14 AllVectors(n) = GetVector(0, y, y, 0, 1, -1) n += 1 Next For x = 1 To 10 AllVectors(n) = GetVector(x, 14, 14, x, 1, -1) n += 1 Next levindex += 1 lev(levindex) = n '左上 For x = 4 To 14 AllVectors(n) = GetVector(x, 14, 0, 14 - x, -1, -1) n += 1 Next For y = 13 To 4 Step -1 AllVectors(n) = GetVector(14, y, 14 - y, 0, -1, -1) n += 1 Next levindex += 1 lev(levindex) = n '分配到点记录表 Dim i As Integer For y = 0 To 14 For x = 0 To 14 Dim ls(3) As mVector52E '遍历全部向量，将点所在的向量保存到ls。 For levindex = 0 To 3 For i = lev(levindex) To lev(levindex + 1) - 1 Dim tmpvector As mVector52E = AllVectors(i) If tmpvector.InLine(y * 15 + x) Then ls(levindex) = tmpvector Exit For End If Next Next VectorsOfPoint(y * 15 + x) = ls Next Next End Sub '根据起点终点初始化全部坐标点（用一个字节表示） Private Function GetVector(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, dx As Integer, dy As Integer) As mVector52E '向量上的全部点。 Dim ps() As Byte = Nothing '当前坐标X,Y,记数。 Dim x As Integer = -1, y As Integer = -1, cst As Integer '从向量起点遍历，直到终点，把每一个点记录下来。 Do Until x = x2 AndAlso y = y2 x = x1 + dx * cst y = y1 + dy * cst ReDim Preserve ps(cst) ps(cst) = y * 15 + x '将坐标转换为数组下标 cst += 1 Loop '将向量分割为长度5-9的若干个子向量。 Return New mVector52E(ps, dx, dy) End Function Public Sub Clear() Dim i As Integer For i = 0 To 71 AllVectors(i).Clear() Next End Sub End Class Public Class mZobristForVector Private Structure mVectorItem Public cLine() As Integer '冲棋信息,30 Public key As Integer '键,31 Public len As Integer '长,32 Sub New(vlen As Integer) len = vlen '因为10-14长度都保存在一个表里，而key的计算方法是按位排列，所以重复非常多，必须用len加以区分。覆盖策略是长度大的优先保存。 ReDim cLine(vlen - 1) End Sub Shared Sub Clear(ByRef mvi As mVectorItem) mvi.key = -1 mvi.len = mConstValue.ZeroLinkArrLen ReDim mvi.cLine(mConstValue.ZeroLinkArrLen - 1) End Sub End Structure Private Shared hstb(mConstValue.HASH_SIZEOFVECTOR - 1) As mVectorItem '表 Shared Sub New() Dim i As Integer For i = 0 To mConstValue.HASH_SIZEOFVECTOR - 1 hstb(i) = New mVectorItem(mConstValue.ZeroLinkArrLen - 1) '用最长长度（30）来初始化，这样每一项大小一样大。 mVectorItem.Clear(hstb(i)) Next End Sub Shared Sub Clear() Dim i As Integer For i = 0 To mConstValue.HASH_SIZEOFVECTOR - 1 mVectorItem.Clear(hstb(i)) Next End Sub '保存置换表项。返回值：0=未替换，1=替换空项，2=替换已有项。 Shared Function RecordHash(vector As mVector52E) As Integer Dim ret As Integer = 0 Dim hsh As mVectorItem = hstb(vector.key And (mConstValue.HASH_SIZEOFVECTOR - 1)) '空项 If hsh.key = -1 Then ret = 1 Else '已有项长度小于等于新长度，且最大冲棋值小于等于要保存值 If hsh.len <= vector.len Then ret = 2 End If '替换 If ret > 0 Then Array.Copy(vector.cLine, hsh.cLine, vector.len * 2) hsh.key = vector.key hsh.len = vector.len End If hstb(vector.key And (mConstValue.HASH_SIZEOFVECTOR - 1)) = hsh Return ret End Function '提取置换表项。返回值表示是否成功。 Shared Function ProbeHash(vector As mVector52E) As Boolean Dim hsh As mVectorItem = hstb(vector.key And (mConstValue.HASH_SIZEOFVECTOR - 1)) '空项或不等 If hsh.len <> vector.len OrElse hsh.key <> vector.key Then Return False '返回置换表项 Array.Copy(hsh.cLine, vector.cLine, vector.len * 2) Return True End Function End Class
上面是向量和向量管理器以及对应的置换表的代码。向量一共有72个，都存储在管理器中。用9长度合成10-14的长度，并且计算点所对应的向量，实现下子、提子函数。
Public Class mPosition '轮到谁走，0=白方，1=黑方 Public sdPlayer As Integer '距离根节点的步数 Public nDistance As Integer '电脑走的棋 Public mvResult As Integer '各点的冲棋值表 Public cpInfo() As Integer '待排序坐标表 Dim pslst(1)() As Byte '根据cpInfo排序 Dim cplst(1)() As Integer '向量管理 Public mVectorManager As New mVectorManager '当前局面密匙结构 Public poskey As mZobristForPosition.mPosKey Sub New() sdPlayer = 1 StartUp() ReDim cpInfo(mConstValue.ZerocpPosArrLen - 1) ReDim pslst(0)(mConstValue.BoardSize - 1) ReDim pslst(1)(mConstValue.BoardSize - 1) ReDim cplst(0)(mConstValue.BoardSize - 1) ReDim cplst(1)(mConstValue.BoardSize - 1) Array.Copy(mConstValue.BoardPointList, pslst(0), mConstValue.BoardSize) Array.Copy(mConstValue.BoardPointList, pslst(1), mConstValue.BoardSize) mVectorManager.Clear() mZobristForPosition.Clear() mZobristForPosition.mPosKey.Clear(poskey) mZobristForVector.Clear() End Sub '清理变化，恢复初始值。 Public Sub StartUp() nDistance = 0 mvResult = -1 End Sub '设置棋盘上点的棋子. Public Sub SetPlayer(point As Byte, player As Integer) SyncLock cpInfo Dim i, j As Integer '若是下一个空子（撤销招法），则局面更改玩家为上一步玩家、步数减一；否则，局面更改为当前玩家，步数加一。 If player = 2 Then poskey = mZobristForPosition.SetPlayer(poskey, point, 1 - sdPlayer) '更新局面KEY nDistance -= 1 '更新走棋步数 Else poskey = mZobristForPosition.SetPlayer(poskey, point, sdPlayer) nDistance += 1 End If '在指定点上下一个白、黑或空子（撤销招法）。 Dim tmpvector As mVector52E Dim tmpPoint As Integer = -1 For i = 0 To 3 tmpvector = mVectorManager.VectorsOfPoint(point)(i) If tmpvector IsNot Nothing Then If tmpvector.key <> 0 Then '只更新有子向量 '冲棋表更新第一步：删除原向量产生的影响 For j = 0 To tmpvector.len - 1 tmpPoint = tmpvector.VectorPoint2BoardPoint(j) cpInfo(tmpPoint) -= tmpvector.cLine(j) cpInfo(tmpPoint + mConstValue.BoardSize) -= tmpvector.cLine(j + tmpvector.len) Next End If tmpvector.SetPlayer(tmpvector.BoardPoint2VectorPoint(point), player) '冲棋表更新第二步：添加新向量的影响 If tmpvector.key <> 0 Then For j = 0 To tmpvector.len - 1 tmpPoint = tmpvector.VectorPoint2BoardPoint(j) cpInfo(tmpPoint) += tmpvector.cLine(j) cpInfo(tmpPoint + mConstValue.BoardSize) += tmpvector.cLine(j + tmpvector.len) Next End If End If Next '最后，交换走棋方。 sdPlayer = 1 - sdPlayer End SyncLock End Sub '进行粗略估值 '已胜利局面中有5个以上2560-N，实际上有一个点大于1024即可判定胜负。 '一个点上两个活三或更多则可以杀棋，即32*2就是杀棋。 '一个点上一个活三或更多则是冲棋，即32以上就是冲棋。 Function Evaluate() As Integer SyncLock cpInfo Dim csPlayer As Integer = 1 - sdPlayer '对方 Dim vl(1) As Integer '总分 Dim curcpInfocLine(1) As Integer '当前冲棋值 '分离 Array.Copy(cpInfo, 0, cplst(0), 0, mConstValue.BoardSize) 'CopyMemory(cplst(0), cpInfo, mConstValue.BoardSize) Array.Copy(cpInfo, mConstValue.BoardSize, cplst(1), 0, mConstValue.BoardSize) '排序 Array.Sort(cplst(0)) Array.Sort(cplst(1)) '遍历 For i = mConstValue.BoardSize - 1 To 0 Step -1 curcpInfocLine(0) = cplst(0)(i) curcpInfocLine(1) = cplst(1)(i) '已有一方胜利 If curcpInfocLine(csPlayer) >= mConstValue.WIN_VALUE Then Return -mConstValue.MATE_VALUE If curcpInfocLine(sdPlayer) >= mConstValue.WIN_VALUE Then Return mConstValue.MATE_VALUE '有2个或更多成5（或长连）点 If curcpInfocLine(csPlayer) >= mConstValue.LinkTypel50 AndAlso cplst(csPlayer)(i - 1) >= mConstValue.LinkTypel50 Then Return -mConstValue.MATE_VALUE If curcpInfocLine(sdPlayer) >= mConstValue.LinkTypel50 AndAlso cplst(sdPlayer)(i - 1) >= mConstValue.LinkTypel50 Then Return mConstValue.MATE_VALUE '将冲棋值大于l12的点的冲棋值之和作为评价 If curcpInfocLine(0) > mConstValue.LinkTypel21 Then vl(0) += curcpInfocLine(0) If curcpInfocLine(1) > mConstValue.LinkTypel21 Then vl(1) += curcpInfocLine(1) Next Return vl(sdPlayer) - vl(1 - sdPlayer) End SyncLock End Function '有子棋盘 Dim tb As New BitArray(mConstValue.BoardSize) '排序/分类截取 Function NextGenerateMove(ByRef retval() As Byte, ByRef InCheck As Integer, InCheckOnly As Boolean) As Integer SyncLock cpInfo tb.SetAll(False) '1、排序 Array.Copy(cpInfo, 0, cplst(0), 0, mConstValue.BoardSize) Array.Copy(cpInfo, mConstValue.BoardSize, cplst(1), 0, mConstValue.BoardSize) Array.Sort(pslst(0), New mComparer(cplst(0))) Array.Sort(pslst(1), New mComparer(cplst(1))) '2、分类截取 Dim cnt As Integer, csPlayer As Integer = 1 - sdPlayer '已经有一方胜利 If GetcplstByLinkType(cplst(csPlayer), pslst(csPlayer), retval, cnt, mConstValue.WIN_VALUE) > 0 Then Return -1 If GetcplstByLinkType(cplst(sdPlayer), pslst(sdPlayer), retval, cnt, mConstValue.WIN_VALUE) > 0 Then Return -1 '成五或长连 If GetcplstByLinkType(cplst(sdPlayer), pslst(sdPlayer), retval, cnt, mConstValue.LinkTypel50) > 0 Then Return cnt - 1 End If If GetcplstByLinkType(cplst(csPlayer), pslst(csPlayer), retval, cnt, mConstValue.LinkTypel50) > 0 Then Return cnt - 1 End If '42,41+32,32+32 If GetcplstByLinkType(cplst(csPlayer), pslst(csPlayer), retval, cnt, mConstValue.LinkTypel32 * 2) > 0 Then InCheck = InCheck Or (2 - csPlayer) End If If GetcplstByLinkType(cplst(sdPlayer), pslst(sdPlayer), retval, cnt, mConstValue.LinkTypel32 * 2) > 0 Then InCheck = InCheck Or (2 - sdPlayer) End If If cnt > 2 Then Return cnt - 1 Else GetcplstByLinkType(cplst(sdPlayer), pslst(sdPlayer), retval, cnt, mConstValue.LinkTypel32) GetcplstByLinkType(cplst(csPlayer), pslst(csPlayer), retval, cnt, mConstValue.LinkTypel32) If cnt > 0 Then InCheck = 0 Return cnt - 1 End If End If If InCheckOnly Then Return cnt - 1 GetcplstByLinkType(cplst(csPlayer), pslst(csPlayer), retval, cnt, mConstValue.LinkTypel31) GetcplstByLinkType(cplst(sdPlayer), pslst(sdPlayer), retval, cnt, mConstValue.LinkTypel31) If cnt > 0 Then Return cnt - 1 GetcplstByLinkType(cplst(csPlayer), pslst(csPlayer), retval, cnt, mConstValue.LinkTypel22) GetcplstByLinkType(cplst(sdPlayer), pslst(sdPlayer), retval, cnt, mConstValue.LinkTypel22) Return cnt - 1 End SyncLock End Function Private Function GetcplstByLinkType(cplst() As Integer, pslst() As Byte, ByRef retval() As Byte, ByRef cnt As Integer, Threshold As Integer) As Integer Dim i, tp, tv, tcnt, bkv As Integer For i = 0 To mConstValue.BoardSize - 1 tp = pslst(i) tv = cplst(tp) If tv < Threshold Then Exit For bkv = tv If tb(tp) = False Then retval(cnt) = tp cnt += 1 tcnt += 1 tb(tp) = True End If Next Return tcnt End Function Public Overrides Function ToString() As String Dim i As Integer, s As Integer Dim tmpstr As String = String.Empty For i = 0 To cpInfo.Length - 1 tmpstr &= Space(6 - CStr(cpInfo(i)).Length) & cpInfo(i) If i + 1 <= cpInfo.Length / 2 Then s = 15 Else s = 30 If ((i + 1) Mod 15) = 0 Then tmpstr &= Space(6) & (s - (i \ 15)) & " " & (i Mod mConstValue.BoardSize) & vbCrLf If i + 1 = cpInfo.Length / 2 Then tmpstr &= "-----A-----B-----C-----D-----E-----F-----G-----H-----I-----J-----K-----L-----M-----N-----O------" & vbCrLf Next Return tmpstr & "-----A-----B-----C-----D-----E-----F-----G-----H-----I-----J-----K-----L-----M-----N-----O------" & vbCrLf End Function End Class Public Class mComparer : Implements IComparer(Of Byte) Private cline() As Integer Sub New(ps() As Integer) cline = ps End Sub Public Function Compare(x As Byte, y As Byte) As Integer Implements System.Collections.Generic.IComparer(Of Byte).Compare Return cline(y) - cline(x) End Function End Class Imports System.Security.Cryptography Public Class mZobristForPosition '置换表项结构 Private Structure mPosZobItem Public dwLock0 As Long '锁 Public ucDepth As Integer '深度 Public ucFlag As mConstValue.HASHType '节点类型 Public svl As Integer '分值 Public wmv As Integer '招法 Public nDistance As Integer Public dwLock1 As Long '锁 Shared Sub Clear(ByRef mzp As mPosZobItem) mzp.dwLock0 = 0L mzp.ucDepth = 0 mzp.ucFlag = mConstValue.HASHType.HASH_ALPHA mzp.svl = 0 mzp.wmv = 0 mzp.nDistance = 0 mzp.dwLock1 = 0L End Sub End Structure '密匙结构 Public Structure mPosKey Public key As Integer '用以计算存储位置的键 Public dwLock0 As Long '锁 Public dwLock1 As Long Shared Sub Clear(ByRef mpk As mPosKey) mpk.key = 0 mpk.dwLock0 = 0L mpk.dwLock1 = 0L End Sub Public Overrides Function ToString() As String Return "key " & Hex(key) & " dwlock0 " & Hex(dwLock0) & " dwlock1 " & Hex(dwLock1) End Function Public Overrides Function Equals(obj As Object) As Boolean Dim tmp As mPosKey = CType(obj, mPosKey) Return tmp.key = key AndAlso tmp.dwLock0 = dwLock0 AndAlso tmp.dwLock1 = dwLock1 End Function End Structure '密匙流 Private Shared table(1)() As mPosKey '置换表 Private Shared hstb(mConstValue.HASH_SIZEOFPOS - 1) As mPosZobItem Shared Sub New() '初始化密匙流 ReDim table(0)(224) ReDim table(1)(224) Dim i, j As Integer For i = 0 To 224 For j = 0 To 1 table(j)(i).key = MD5Zob(j, i) table(j)(i).dwLock0 = RC2Zob(j, i) table(j)(i).dwLock1 = DESZob(j, i) Next Next End Sub Shared Sub Clear() Dim i As Integer For i = 0 To mConstValue.HASH_SIZEOFPOS - 1 mPosZobItem.Clear(hstb(i)) Next End Sub 'MD5加密算法 Private Shared Function MD5Zob(k1 As Integer, k2 As Integer) As Integer Dim md5 As New MD5CryptoServiceProvider Dim inputByteArray As Byte() = New Byte() {k1, k2} Dim mdByte As Byte() = md5.ComputeHash(inputByteArray) Return BitConverter.ToInt32(mdByte, 0) End Function 'RC2，DES算法的键和动量 Private Shared key As Byte() = New Byte() {&H12, &H34, &H56, &H78, &H90, &HAB, &HCD, &HEF} Private Shared iv As Byte() = New Byte() {&H23, &H34, &H45, &H56, &H67, &H78, &H89, &H9A} 'RC2加密算法 Private Shared Function RC2Zob(k1 As Byte, k2 As Byte) As Long Dim rc2 As New RC2CryptoServiceProvider Dim inputByteArray As Byte() = New Byte() {k1, k2} rc2.Key = key rc2.IV = iv Dim ms As New System.IO.MemoryStream Dim cs As New CryptoStream(ms, rc2.CreateEncryptor, CryptoStreamMode.Write) cs.Write(inputByteArray, 0, inputByteArray.Length) cs.FlushFinalBlock() Return BitConverter.ToInt64(ms.ToArray(), 0) End Function 'DES加密算法 Private Shared Function DESZob(k1 As Byte, k2 As Byte) As Long Dim rc2 As New DESCryptoServiceProvider Dim inputByteArray As Byte() = New Byte() {k1, k2} rc2.Key = key rc2.IV = iv Dim ms As New System.IO.MemoryStream Dim cs As New CryptoStream(ms, rc2.CreateEncryptor, CryptoStreamMode.Write) cs.Write(inputByteArray, 0, inputByteArray.Length) cs.FlushFinalBlock() Return BitConverter.ToInt64(ms.ToArray(), 0) End Function '获取新键值和锁 Public Shared Function SetPlayer(poskey As mPosKey, point As Integer, player As Integer) As mPosKey Dim tmp As mPosKey = table(player)(point) Dim ret As New mPosKey ret.key = poskey.key Xor tmp.key ret.dwLock0 = poskey.dwLock0 Xor tmp.dwLock0 ret.dwLock1 = poskey.dwLock1 Xor tmp.dwLock1 Return ret End Function '提取置换表项。 Public Shared Function ProbeHash(poskey As mPosKey, vlAlpha As Integer, vlBeta As Integer, nDepth As Integer, nDistance As Integer, ByRef mv As Integer) As Integer SyncLock hstb Dim bMate As Boolean '杀棋标志：如果是杀棋，那么不需要满足深度条件 Dim hsh As mPosZobItem = hstb(poskey.key And (mConstValue.HASH_SIZEOFPOS - 1)) '用and运算代替mod运算 If (hsh.dwLock0 <> poskey.dwLock0) OrElse (hsh.dwLock1 <> poskey.dwLock1) Then '未找到 mv = -1 Return -mConstValue.MATE_VALUE End If mv = hsh.wmv bMate = False If hsh.svl > mConstValue.WIN_VALUE Then '当前玩家胜利 hsh.svl -= nDistance '提取时恢复杀棋步 bMate = True ElseIf hsh.svl < -mConstValue.WIN_VALUE Then '对方胜利 hsh.svl += nDistance bMate = True End If If hsh.ucDepth >= nDepth OrElse bMate Then If hsh.ucFlag = mConstValue.HASHType.HASH_BETA Then 'BETA截断时，要超出边界。 Return IIf(hsh.svl >= vlBeta, hsh.svl, -mConstValue.MATE_VALUE) ElseIf (hsh.ucFlag = mConstValue.HASHType.HASH_ALPHA) Then 'ALPHA截断时，要在边界之内。 Return IIf(hsh.svl <= vlAlpha, hsh.svl, -mConstValue.MATE_VALUE) End If Return hsh.svl End If Return -mConstValue.MATE_VALUE End SyncLock End Function ' 保存置换表项 Public Shared Sub RecordHash(poskey As mPosKey, nFlag As Integer, vl As Integer, nDepth As Integer, nDistance As Integer, mv As Integer) SyncLock hstb Dim hsh As mPosZobItem = hstb(poskey.key And (mConstValue.HASH_SIZEOFPOS - 1)) '用and运算代替mod运算 If hsh.ucDepth > nDepth Then Return '存储深度比现在深度小时，才更新。 If hsh.ucDepth = nDepth AndAlso hsh.nDistance > nDistance Then Return '冲棋延伸局面计算量更大，所以保存更优先。 hsh.ucFlag = nFlag hsh.ucDepth = nDepth hsh.nDistance = nDistance If vl > mConstValue.WIN_VALUE Then hsh.svl = vl + nDistance '存储时用杀棋步影响分值，从而使得覆盖过程可以存储到更快的杀棋。 ElseIf vl < -mConstValue.WIN_VALUE Then hsh.svl = vl - nDistance Else hsh.svl = vl End If hsh.wmv = mv hsh.dwLock0 = poskey.dwLock0 hsh.dwLock1 = poskey.dwLock1 hstb(poskey.key And (mConstValue.HASH_SIZEOFPOS - 1)) = hsh End SyncLock End Sub End Class
以上是局面和局面置换表。思路很清楚，值得注意的就是置换表保存时，同样深度下，由于冲棋延伸导致步数更多的局面实际上的深度要比以保存的深步数差个，为了方便代码中按同样深度保存了，实际上保存时应该重新计算深度（或许我们可以用深度与步数之和的大小关系作为覆盖依据），但即使现在的代码也可以提高很多命中率，而且显见这些提高的命中都是延伸若干步之后的结果，这为我们赢得了宝贵的时间。
Imports System.Threading Public Class mPVSAlphaBeta Public pos As mPosition '评价 Public Event SearchEnd(a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, vlbest As Integer, pline As mPVLine) '记数统计 Public a, b, c, d, e As Integer '用局面类初始化 Sub New(p As mPosition) pos = p End Sub '超出边界(Fail-Soft)的Alpha-Beta搜索过程。 Public Function AlphaBeta(vlAlpha As Integer, vlBeta As Integer, nDepth As Integer, pLine As mPVLine, chk As Integer) As Integer b += 1 d += 1 Dim line As New mPVLine 'pvs走法 Dim nNewDepth As Integer '搜索深度 Dim nGenMove As Integer '子节点数 Dim vl, vlBest, mvBest As Integer '评价分值，最佳分值，最佳走法 Dim InCheck As Integer '走一步棋时是否形成冲棋 Dim mvs(224) As Byte '子节点走法缓存 Dim mv As Integer '当前走法 Dim nHashFlag As mConstValue.HASHType '置换表标志 Dim mvHash As Integer = -1 '哈希表走法 Dim InCheckOnly As Boolean '只生成冲棋走法，用于静态评价（'''''''''''''''''''''''''''注释掉的语句就是静态评价） '最深走法步数 If pos.nDistance > c Then c = pos.nDistance End If '1. 到达水平线，则返回局面评价 If nDepth <= 0 Then '''''''''''''''''''''''''''If chk = 0 Then vl = pos.Evaluate Return vl '''''''''''''''''''''''''''Else '''''''''''''''''''''''''''InCheckOnly = True '''''''''''''''''''''''''''End If End If '2.到达极限深度，则返回局面评价 If pos.nDistance = mConstValue.LIMIT_DEPTH Then Return pos.Evaluate() '3.查找置换表，应用剪裁 vl = mZobristForPosition.ProbeHash(pos.poskey, vlAlpha, vlBeta, nDepth, pos.nDistance, mvHash) If vl > -mConstValue.MATE_VALUE Then a += 1 pos.mvResult = mvHash Return vl End If '不尝试空步剪裁，因为空步剪裁适合于走任何一步都使局面更糟的时候，五子棋不会出现该情况。 '4.初始化最佳值和最佳走法 vlBest = -mConstValue.MATE_VALUE '这样可以知道，是否一个走法都没走过(杀棋) mvBest = -1 '这样可以知道，是否搜索到了Beta走法或PV走法，以便保存到历史表 nGenMove = pos.NextGenerateMove(mvs, InCheck, InCheckOnly) '当nGenMove为-1时，都是无解棋，直接截断。 '5.逐一走这些走法，并进行递归 For i As Integer = 0 To nGenMove mv = mvs(i) pos.SetPlayer(mv, pos.sdPlayer) '冲棋延伸 nNewDepth = IIf(InCheck > 0 AndAlso (InCheck = chk OrElse InCheck > 2 OrElse chk > 2), nDepth, nDepth - 1) 'PVS If vlBest = -mConstValue.MATE_VALUE Then vl = -AlphaBeta(-vlBeta, -vlAlpha, nNewDepth, line, InCheck) Else vl = -AlphaBeta(-vlAlpha - 1, -vlAlpha, nNewDepth, line, InCheck) '空窗探测 If vl > vlAlpha AndAlso vl < vlBeta Then '<=alpha说明没有更好的棋，>=beta说明发生剪裁。 vl = -AlphaBeta(-vlBeta, -vlAlpha, nNewDepth, line, InCheck) End If End If pos.SetPlayer(mvs(i), 2) '进行Alpha-Beta大小判断和截断 If (vl > vlBest) Then '找到最佳值(但不能确定是Alpha、PV还是Beta走法) vlBest = vl '"vlBest"就是目前要返回的最佳值，可能超出Alpha-Beta边界 If (vl >= vlBeta) Then '找到一个Beta走法 nHashFlag = mConstValue.HASHType.HASH_BETA mvBest = mv 'Beta走法要保存到历史表 Exit For 'Beta截断 End If If (vl > vlAlpha) Then '找到一个PV走法 nHashFlag = mConstValue.HASHType.HASH_PV mvBest = mv 'PV走法要保存到置换表 vlAlpha = vl '缩小Alpha-Beta边界 pLine.argmove(0) = mvBest '记录最佳走法路径 Array.Copy(line.argmove, 0, pLine.argmove, 1, line.cmove + 1) '加入后续走法 pLine.cmove = line.cmove + 1 '更新走法总数 End If End If Next '6.所有走法都搜索完了，把最佳走法(不能是Alpha走法)保存到历史表，返回最佳值 If vlBest = -mConstValue.MATE_VALUE Then '如果是杀棋，就根据杀棋步数给出评价 Return pos.nDistance - mConstValue.MATE_VALUE End If '7.记录最佳招法 If mvBest <> -1 Then '8.记录到置换表 mZobristForPosition.RecordHash(pos.poskey, nHashFlag, vlBest, nDepth, pos.nDistance, mvBest) If pos.nDistance = 1 Then 'pos.mvResult = mvBest End If End If '9.返回最佳分值 Return vlBest End Function End Class Public Class mPVLine Public cmove As Integer '路线中着法的数量； Public argmove(mConstValue.LIMIT_DEPTH - 1) As Byte 'PV路线上的着法列表 End Class Public Class mSearch Public pos As mPosition '评价 Public pvLine As New mPVLine '走法路线 Public stopWatch As New Stopwatch '计时器 Public Event EndDepth(depth As Integer, nPos As Integer, bestMove As Integer, bestVal As Integer, lastTime As Integer, pvMine As String) Public Event EndAllDepth(lastTime As Integer, depth As Integer, nHashTable As Integer, nPos As Integer, maxDistance As Integer, NPS As Integer, bestVal As Integer) Public pvs As mPVSAlphaBeta Sub New(position As mPosition) pos = position pvs = New mPVSAlphaBeta(pos) End Sub '根节点搜索 Function SearchRoot(nDepth As Integer) Dim line As New mPVLine 'pvs走法 Dim nGenMove As Integer '子节点数 Dim vl, vlBest, mvBest As Integer '评价分值，最佳分值，最佳走法 Dim InCheck As Integer '走一步棋时是否形成冲棋 Dim mvs(224) As Byte '子节点走法缓存 Dim mv As Integer '当前走法 Dim mvHash As Integer = -1 pvLine.cmove = -1 vlBest = -mConstValue.MATE_VALUE '这样可以知道，是否一个走法都没走过(杀棋) mvBest = -1 '这样可以知道，是否搜索到了Beta走法或PV走法，以便保存到历史表 nGenMove = pos.NextGenerateMove(mvs, InCheck, False) '当nGenMove为-1时，都是无解棋，直接截断。 For i As Integer = 0 To nGenMove mv = mvs(i) pos.SetPlayer(mv, pos.sdPlayer) 'PVS If vlBest = -mConstValue.MATE_VALUE Then vl = -pvs.AlphaBeta(-mConstValue.MATE_VALUE, mConstValue.MATE_VALUE, nDepth - 1, line, InCheck) Else vl = -pvs.AlphaBeta(-vlBest - 1, -vlBest, nDepth - 1, line, InCheck) '空窗探测 If vl > vlBest Then '<=alpha说明没有更好的棋，>=beta说明发生剪裁。 vl = -pvs.AlphaBeta(-mConstValue.MATE_VALUE, -vlBest, nDepth - 1, line, InCheck) End If End If pos.SetPlayer(mvs(i), 2) '进行Alpha-Beta大小判断和截断 If (vl > vlBest) Then '找到最佳值(但不能确定是Alpha、PV还是Beta走法) vlBest = vl '"vlBest"就是目前要返回的最佳值，可能超出Alpha-Beta边界 '找到一个PV走法 mvBest = mv 'PV走法要保存到置换表 pvLine.argmove(0) = mvBest '记录最佳走法路径 Array.Copy(line.argmove, 0, pvLine.argmove, 1, line.cmove) '加入后续走法 pvLine.cmove = line.cmove + 1 '更新走法总数 End If Next '7.记录最佳招法 If mvBest <> -1 Then '8.记录到置换表 mZobristForPosition.RecordHash(pos.poskey, mConstValue.HASHType.HASH_PV, vlBest, nDepth, pos.nDistance, mvBest) pos.mvResult = mvBest End If '9.返回最佳分值 Return vlBest End Function '===============================迭代加深=============================== '迭代加深搜索过程 Function SearchMain() As Integer Dim bctm As Integer '过去的总时间 pvs.d = 0 pvs.e = 0 Dim i, t, vl As Integer '迭代加深过程 For i = 1 To mConstValue.LIMIT_DEPTH - 1 pvs.b = 0 pos.StartUp() stopWatch.Restart() '最多招法记录 'vl = AlphaBeta(-mConstValue.MATE_VALUE, mConstValue.MATE_VALUE, i, pvLine) vl = SearchRoot(i) stopWatch.Stop() t = stopWatch.ElapsedMilliseconds '本次运算所用时间 '若剩余时间小于上层搜索时间则退出搜索 bctm += t '至今所用全部时间 RaiseEvent EndDepth(i, pvs.b, pos.mvResult, vl, t, PVLine2Str()) '搜索到杀棋，就终止搜索 If vl > mConstValue.WIN_VALUE Then '计算机胜利 Exit For End If If vl < -mConstValue.WIN_VALUE Then '玩家胜利 Exit For End If If mConstValue.OutTime - bctm < t Then Exit For End If Next RaiseEvent EndAllDepth(bctm, i, pvs.a, pvs.d, pvs.c, pvs.d * 1000 \ IIf(bctm = 0, 1, bctm), vl) Return pos.mvResult End Function '============================================================================== Function PVLine2Str() As String Dim tmp As String = "bestmove " Dim i As Integer For i = 0 To pvLine.cmove - 1 If i = 1 Then tmp &= " ponder " If i = 2 Then tmp &= " moveline " tmp &= mConstValue.PosPoint2Str(pvLine.argmove(i) Mod 15) & (15 - (pvLine.argmove(i) \ 15)) & " " ' & "[" & (pvLine.argmove(i) & "]") Next Return tmp End Function End Class
最后，就是分离了根节点的剪裁和迭代加深了。其实就是一个带有冲棋延伸、PVS的ALPHA-BETA剪裁。有什么不懂的可以留言，有什么指教的更要留言！
好了，就这么多。然后传上源码。VS2010，.NET FRAMEWORK 4.0。
。。。。找不到上传了呢。。。。。。。。。这里这里
发一个最新版本。棋力远高于原来这个。点击下载
全部文章和源码整理完成，以后更新也会在下面地址：
