經過這半年左右的學習和探索,現在對五子棋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。
。。。。找不到上傳了呢。。。。。。。。。這里這里
發一個最新版本。棋力遠高於原來這個。點擊下載
全部文章和源碼整理完成,以后更新也會在下面地址: