Private wBitArr As BitArray
Private bBitArr As BitArray
3、如何操作位棋盤
直接上代碼：
'位棋盘
Public Class mBitBoard
'用bitarray代替byte数组，提高读写速度。（bitarray内部实现是用integer数组，每一个元素是32字节，所以寻址速度要比用byte数组快很多）
'0=白方，1=黑方，2=空
Private wBitArr As BitArray
Private bBitArr As BitArray
'15*15的棋盘。
Sub New()
wBitArr = New BitArray(225)
bBitArr = New BitArray(225)
End Sub
'设置棋子
Sub [Set](index As Integer, value As Integer)
If value = 0 Then
wBitArr.Set(index, True)
ElseIf value = 1 Then
bBitArr.Set(index, True)
Else
bBitArr.Set(index, False)
wBitArr.Set(index, False)
End If
End Sub
'获取棋子
Function [Get](index As Integer) As Integer
If wBitArr.Get(index) Then Return 0
If bBitArr.Get(index) Then Return 1
Return 2
End Function
'繪製棋子
Private Sub pnlBoard_Paint(sender As System.Object, e As System.Windows.Forms.PaintEventArgs) Handles pnlBoard.Paint
e.Graphics.DrawImage(My.Resources._2064, Point.Empty)
For i As Integer = 0 To 224
If ucpcSquares.Get(i) = 1 Then e.Graphics.DrawImage(bb, New Point((i Mod 15) * cs.Height, (i \ 15) * cs.Height) + co)
If ucpcSquares.Get( i) = 0 Then e.Graphics.DrawImage(bw, New Point((i Mod 15) * cs.Height, (i \ 15) * cs.Height) + co)
Next
End Sub
首先繪製棋盤圖像，然後繪製棋子。
下子的代碼是這樣的：
'下子
Private Sub pnlBoard_MouseDown(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles pnlBoard.MouseDown
Dim sdr = CType(sender, Panel)
'鼠標坐標轉棋盤坐標
Dim p As Point = e.Location - co
pX \= cs.Width
pY \= cs.Height
'下一個白子
If e.Button = Windows.Forms.MouseButtons.Left Then
ucpcSquares.Set(pY * 15 + pX, 0)
'更新顯示
pnlBoard_Paint(sdr, New PaintEventArgs( sdr.CreateGraphics, sdr.DisplayRectangle))
End If
End Sub
很簡單不是嗎。
Public Class Form1
'黑白棋子
Private bb As Bitmap
Private bw As Bitmap
'棋子偏移
Private co As Point = New Point(5, 5)
'棋子大小
Private cs As Size = New Size(25, 25)
'位棋盘
Private ucpcSquares As mBitBoard
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
'初始化棋子
Dim resbmp As Bitmap = New Bitmap(My.Resources._7041, cs.Width * 4, cs.Height)
Dim allbmp As Bitmap = New Bitmap(resbmp.Width \ 2, resbmp.Height)
'获取棋子图像
For y As Integer = 0 To allbmp.Height - 1
For x As Integer = 0 To allbmp.Width - 1
If resbmp.GetPixel(x + allbmp.Width, y).ToArgb = Color.Black.ToArgb Then allbmp.SetPixel(x, y, resbmp.GetPixel(x, y))
Next
Next
bb = allbmp.Clone(New Rectangle(0, 0, allbmp.Width / 2, allbmp.Height), allbmp.PixelFormat)
bw = allbmp.Clone(New Rectangle(allbmp.Width / 2, 0, allbmp.Width / 2, allbmp.Height), allbmp.PixelFormat)
'==========================开局棋型可在这里设置==============================
ucpcSquares = New mBitBoard()
ucpcSquares.Set(7 * 15 + 7, 1)
End Sub
'绘制棋子
Private Sub pnlBoard_Paint(sender As System.Object, e As System.Windows.Forms.PaintEventArgs) Handles pnlBoard.Paint
e.Graphics.DrawImage(My.Resources._2064, Point.Empty)
For i As Integer = 0 To 224
If ucpcSquares.Get(i) = 1 Then e.Graphics.DrawImage(bb, New Point((i Mod 15) * cs.Height, (i \ 15) * cs.Height) + co)
If ucpcSquares.Get(i) = 0 Then e.Graphics.DrawImage(bw, New Point((i Mod 15) * cs.Height, (i \ 15) * cs.Height) + co)
Next
End Sub
'下子
Private Sub pnlBoard_MouseDown(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles pnlBoard.MouseDown
Dim sdr = CType(sender, Panel)
'鼠标坐标转棋盘坐标
Dim p As Point = e.Location - co
p.X \= cs.Width
p.Y \= cs.Height
'下一个白子
If e.Button = Windows.Forms.MouseButtons.Left Then
ucpcSquares.Set(p.Y * 15 + p.X, 0)
'更新显示
pnlBoard_Paint(sdr, New PaintEventArgs(sdr.CreateGraphics, sdr.DisplayRectangle))
End If
End Sub
'求所有的向量
Dim x, y As Integer
'横向
For y = 0 To 14
all.Add(GetVector(0, y, 14, y, 1, 0))
Next
'纵向
For x = 0 To 14
all.Add(GetVector(x, 0, x, 14, 0, 1))
Next
'右上
For y = 4 To 14
all.Add(GetVector(0, y, y, 0, 1, -1))
Next
For x = 1 To 10
all.Add(GetVector(x, 14, 14, x, 1, -1))
Next
'左上
For x = 4 To 14
all.Add(GetVector(x, 14, 0, 14 - x, -1, -1))
Next
For y = 13 To 4 Step -1
all.Add(GetVector(14, y, 14 - y, 0, -1, -1))
Next
'分配到点记录表
Dim i As Integer
For x = 0 To 14
For y = 0 To 14
Dim ls As New List(Of mVector)
'遍历全部向量，将点所在的向量保存到ls。
For i = 0 To 71
If InLine(i, y * 15 + x) <> -1 Then ls.Add(all(i))
Next
'以点坐标为键，加入表中。
hs.Add(y * 15 + x, ls)
Next
Next
'评价向量的当前情况
Sub Evaluate(ucpc As mBitBoard)
'向量点数组最大下标
Dim infend As Integer = ps.Length - 1
'循环变量
Dim i As Integer
'本方、对方在向量上的子分布信息
Dim inf1(infend) As Byte
Dim inf2(infend) As Byte
'循环访问向量上指向的棋盘点
For i = 0 To infend
If ucpc.Get(ps(i)) = 1 Then '黑子
inf1(i) = 1
inf2(i) = 2
ElseIf ucpc.Get(ps(i)) = 0 Then '白子
inf1(i) = 2
inf2(i) = 1
Else '无子
inf1(i) = 0
inf2(i) = 0
End If
Next
'白子棋型
linkInfs(1) = EvaluateShape(inf1, 0, infend)
'更新冲棋点坐标为棋盘坐标
For i = 0 To linkInfs(1).cqpend
linkInfs(1).cqp(i) = ps(linkInfs(1).cqp(i))
Next
'黑子棋型
linkInfs(0) = EvaluateShape(inf2, 0, infend)
For i = 0 To linkInfs(0).cqpend
linkInfs(0).cqp(i) = ps(linkInfs(0).cqp(i))
Next
End Sub
'根据模板进行棋型获取（匹配最高连即返回）。
Private Shared Function EvaluateShape(inf As Byte(), infstart As Integer, infend As Integer) As LinkInfo
Dim count As Integer
Dim lnkinf As New LinkInfo
'长连
If CompareArray(inf, infstart, infend, mll1, count) Then
lnkinf.lnk = 60
Return lnkinf
End If
If CompareArray(inf, infstart, infend, mll2, count) Then
lnkinf.lnk = 60
Return lnkinf
End If
If CompareArray(inf, infstart, infend, mll3, count) Then
lnkinf.lnk = 60
Return lnkinf
End If
If CompareArray(inf, infstart, infend, mll4, count) Then
lnkinf.lnk = 60
Return lnkinf
End If
'成5
If CompareArray(inf, infstart, infend, ml5, count) Then
lnkinf.lnk = 50
Return lnkinf
End If
'活4
If CompareArray(inf, infstart, infend, ml42, count) Then
lnkinf.lnk = 42
'在这里记录的冲棋坐标是inf的下标，也是ps的下标，而不是实际棋盘坐标。
'虽然可以用循环来找到模板当中的0，但是比硬编码要慢很多。
lnkinf.cqp(0) = count
lnkinf.cqp(1) = count + 5
lnkinf.cqpend = 1
Return lnkinf
End If
'统计本方、对方的72向量上各种棋型的信息。
'本方
Select Case all(j).linkInfs(player).lnk
Case 60 '长连
l60_1.Add(all(j).linkInfs(player))
Case 50 '成5
l50_1.Add(all(j).linkInfs(player))
Case 42 '活4
l42_1.Add(all(j).linkInfs(player))
Case 41 '冲4
l41_1.Add(all(j).linkInfs(player))
Case 32 '活3
l32_1.Add(all(j).linkInfs(player))
Case 31 '冲3
l31_1.Add(all(j).linkInfs(player))
Case 22 '活2
l22_1.Add(all(j).linkInfs(player))
End Select
'====================================死棋棋型（长连、禁手、成5）======================================
'1、被杀死
'1.1、对方成5
If l50_2.Count > 0 Then Return -10000
'1.2、对方不禁手
If RestrictedMove <> 1 - player Then
If l60_2.Count > 0 Then Return -10000
End If
'1.3、被禁手
If RestrictedMove = player Then
If l60_1.Count > 0 AndAlso l50_1.Count = 0 Then Return -10000 '长连，但是同时成5不为禁手。
If l32_1.Count > 1 Then Return -10000 '双活三禁手
If l42_1.Count > 1 Then Return -10000 '双活四禁手
If l41_1.Count > 1 Then Return -10000 '双冲四禁手
End If
'超出边界(Fail-Soft)的Alpha-Beta搜索过程。这个过程返回值是一个分值，而最佳走法被记录到一个全局变量（pos.mvResult）。
Public Function SearchFull(vlAlpha As Integer, vlBeta As Integer, nDepth As Integer) As Integer
'循环变量，走法数组最大下标（走法个数-1）
Dim i, nGenMoves As Integer
'分值，最高分值，最佳走法
Dim vl, vlBest, mvBest As Integer
'生成的全部走法（定长，具体有多少个走法由nGenMoves决定）
Dim mvs(MAX_GEN_MOVES) As Byte
'一个Alpha-Beta完全搜索分为以下几个阶段
'1. 到达水平线，则返回局面评价值
If nDepth = 0 Then
Return pos.Evaluate()
End If
'4. 逐一走这些走法，并进行递归
For i = 0 To nGenMoves
pos.AddPiece(mvs(i))
vl = -SearchFull(-vlBeta, -vlAlpha, nDepth - 1)
pos.DelPiece(mvs(i))
' 5. 进行Alpha-Beta大小判断和截断
If (vl > vlBest) Then '找到最佳值(但不能确定是Alpha、PV还是Beta走法)
vlBest = vl '"vlBest"就是目前要返回的最佳值，可能超出Alpha-Beta边界
If (vl >= vlBeta) Then '找到一个Beta走法
mvBest = mvs(i) 'Beta走法要保存到历史表
Exit For 'Beta截断
End If
If (vl > vlAlpha) Then '找到一个PV走法
mvBest = mvs(i) 'PV走法要保存到历史表
vlAlpha = vl '缩小Alpha-Beta边界
End If
End If
Next
'5. 所有走法都搜索完了，把最佳走法(不能是Alpha走法)保存到历史表，返回最佳值
If vlBest = -MATE_VALUE Then
'如果是杀棋，就根据杀棋步数给出评价
Return pos.nDistance - MATE_VALUE
End If
If mvBest <> 0 Then
'如果不是Alpha走法，就将最佳走法保存到历史表
pos.nHistoryTable(mvBest) += nDepth ^ 2
If pos.nDistance = 0 Then
'搜索根节点时，总是有一个最佳走法(因为全窗口搜索不会超出边界)，将这个走法保存下来
pos.mvResult = mvBest
End If
End If
'返回最高分
Return vlBest
End Function
'根据历史走法对合理招法进行排序的排序器。
Class mvsCompare
Implements IComparer
'这个数组是给走法排序的依据，是历史表的引用。
Public Shared ms() As Integer
Public Function Compare(x As Object, y As Object) As Integer Implements System.Collections.IComparer.Compare
Return ms(y) - ms(x)
End Function
End Class
Public Class mPosition
'72成棋向量
Public Vectors As New mVectors
'轮到谁走，0=红方，1=黑方
Public sdPlayer As Integer
'棋盘上的棋子，0=红方，1=黑方，2=无子
Public ucpcSquares As mBitBoard
'距离根节点的步数
Public nDistance As Integer
'禁手玩家
Public RtPlayer As Integer = 2
'电脑走的棋
Public mvResult As Integer
'历史表
Public nHistoryTable(224) As Integer
'初始化棋盘类
Sub New()
ucpcSquares = New mBitBoard()
End Sub
'清空历史表
Public Sub ClearnHistoryTable()
mvResult = 0
Array.Clear(nHistoryTable, 0, 225)
End Sub
'交换走棋者
Sub ChangeSide()
sdPlayer = 1 - sdPlayer
End Sub
'在棋盘上放一枚棋子
Sub AddPiece(sq As Integer)
'更新棋盘
ucpcSquares.Set(sq, sdPlayer)
'更新更新标志和向量上棋子个数
For Each v As mVector In Vectors.hs(sq)
v.pipecount(ucpcSquares.Get(sq)) += 1
v.update = True
Next
'交换走棋方
ChangeSide()
'更新步数
nDistance += 1
End Sub
'从棋盘上拿走一枚棋子
Sub DelPiece(sq As Integer)
For Each v As mVector In Vectors.hs(sq)
v.pipecount(ucpcSquares.Get(sq)) -= 1
v.update = True
Next
ucpcSquares.Set(sq, 2)
ChangeSide()
nDistance -= 1
End Sub
'局面评价函数
Function Evaluate() As Integer
Return Vectors.Evaluate(ucpcSquares, sdPlayer, RtPlayer)
End Function
Sub Startup() '初始化棋盘
sdPlayer = 1
nDistance = 0
For i As Integer = 0 To 224 '没有使用bitarray的setall函数。
ucpcSquares.Set(i, 2)
Next
End Sub
'mvs为全部合理招法
Function GenerateMoves(mvs() As Byte) As Integer '生成所有走法
Dim GenBoard = ucpcSquares.GetGeneratePoints
Dim i As Integer = 0, nGenMoves As Integer = 0
For i = 0 To 224
If GenBoard(i) Then
mvs(nGenMoves) = i
nGenMoves += 1
End If
Next
Return nGenMoves - 1
End Function
想法很簡單，實際上代碼也很簡單，只需要實現一個循環，for i = 1 to n，i是要掃描的深度，在這個循環中調用alpha-beta剪裁即可。代碼就這麼幾行：
'===============================迭代加深===============================
'迭代加深搜索过程
Function SearchMain() As Integer
Dim i, t, vl As Integer
'初始化
pos.ClearnHistoryTable() ' 清空历史表
mvsCompare.ms = pos.nHistoryTable
t = My.Computer.Clock.TickCount ' 初始化定时器
pos.nDistance = 0 '初始步数
winplayr = 2 '胜利者
'迭代加深过程
For i = 1 To LIMIT_DEPTH_SearchFull - 1
Debug.Print("正在迭代：" & i)
vl = SearchFull(-MATE_VALUE, MATE_VALUE, i)
'搜索到杀棋，就终止搜索
If vl > WIN_VALUE Then '计算机胜利
winplayr = 1
Exit For
End If
If vl < -WIN_VALUE Then '玩家胜利
winplayr = 0
Exit For
End If
'超过一秒，就终止搜索
If My.Computer.Clock.TickCount - t > 1000 Then
Exit For
End If
Next
Debug.Print("迭代加深:" & i)
Return pos.mvResult
End Function
'==============================================================================
'====================================空步剪裁=====================================
If pos.nDistance > 0 Then
'1. 到达水平线
If nDepth <= 0 Then Return pos.Evaluate '
'1-1. 到达极限深度就返回局面评价
If pos.nDistance = LIMIT_DEPTH_SearchFull Then Return pos.Evaluate()
'1-2. 尝试空步裁剪(根节点的Beta值是"MATE_VALUE"，所以不可能发生空步裁剪)
If pos.Evaluate() = -3000 Then '被冲棋时，根据冲棋点返回值生成走法，而不是生成全部走法。
'遍历棋型信息，提取全部冲棋点。
For i = 0 To pos.Vectors.lnkinf.Count - 1
For j = 0 To pos.Vectors.lnkinf(i).cqpend
nGenMoves += 1
mvs(nGenMoves) = pos.Vectors.lnkinf(i).cqp(j)
Next
Next
Else '未被冲棋时进行空步剪裁
pos.NullMove()
vl = -SearchFull(-vlBeta, 1 - vlBeta, nDepth - NULL_DEPTH - 1)
pos.UnNullMove()
If (vl >= vlBeta) Then
Return vl
End If
End If
End If
'==================================空步剪裁结束===================================
'==================================静态搜索==================================
'静态(Quiescence)搜索过程，实际上和alpha-beta搜索非常相似，但是目标是不同的，ab搜索达到深度就退出了，不管下面发生什么，哪怕下一步可以形成杀棋。
'而静态搜索是ab搜索的延伸，它将处理这些的情况。
Private Function SearchQuiesc(vlAlpha As Integer, vlBeta As Integer) As Integer
Dim i, nGenMoves As Integer
nGenMoves = -1
Dim vl, vlBest As Integer
Dim mvs(MAX_GEN_MOVES) As Byte
' 一个静态搜索分为以下几个阶段
'1. 到达极限深度就返回局面评价
If pos.nDistance = LIMIT_DEPTH Then Return pos.Evaluate()
'2. 初始化最佳值
vlBest = -MATE_VALUE '这样可以知道，是否一个走法都没走过(杀棋)
'评价局面
vl = pos.Evaluate()
If vl = -3000 Then
'3. 如果被冲棋，则取全部冲棋点作为走法。
For i = 0 To pos.Vectors.lnkinf.Count - 1
For j = 0 To pos.Vectors.lnkinf(i).cqpend
nGenMoves += 1
mvs(nGenMoves) = pos.Vectors.lnkinf(i).cqp(j)
Next
Next
Else
'4.如果不被冲棋, 先做局面评价
If vl > vlBest Then
vlBest = vl
If vl >= vlBeta Then
Return vl
End If
If vl > vlAlpha Then
vlAlpha = vl
End If
End If
'5. 如果局面评价没有截断，生成冲棋走法，冲棋走法本身就是排序的无需再次排序。
If vl = 3000 Then '杀棋时无需进行评价，根本就没有走法，6的循环会被略过直接进入最后评价。
'实际上这几行和3中完全一样，可以提取出来，但是为了结构更清晰，还是单独列出了。
For i = 0 To pos.Vectors.lnkinf.Count - 1
For j = 0 To pos.Vectors.lnkinf(i).cqpend
nGenMoves += 1
mvs(nGenMoves) = pos.Vectors.lnkinf(i).cqp(j)
Next
Next
End If
End If
'6. 逐一走这些走法，并进行递归
For i = 0 To nGenMoves
pos.AddPiece(mvs(i))
vl = -SearchQuiesc(-vlBeta, -vlAlpha)
pos.DelPiece(mvs(i))
'7. 进行Alpha-Beta大小判断和截断
If vl > vlBest Then '找到最佳值(但不能确定是Alpha、PV还是Beta走法)
vlBest = vl '"vlBest"就是目前要返回的最佳值，可能超出Alpha-Beta边界
If vl >= vlBeta Then '找到一个Beta走法
Return vl 'Beta截断
End If
If vl > vlAlpha Then '找到一个PV走法
vlAlpha = vl '缩小Alpha-Beta边界
End If
End If
Next
'8. 所有走法都搜索完了，返回最佳值
Return IIf(vlBest = -MATE_VALUE, pos.nDistance - MATE_VALUE, vlBest)
End Function
'==================================静态搜索结束==================================
我們最好用一個數(key)來記錄一個局面，然後，根據這個數，就能找到評分、類型、深度等信息。怎麼看都是使用key-value的東西，但是我測試了一下，哈希表速度要比前輩們的方法慢很多。他們把這個key處理了一下：變成下標（key mod len)，那麼好吧，這樣做的速度被證實非常快。而這同時也涉及到一些問題，其中最嚴重的就是，如果我把長度設置的較小例如10，那麼它就無法起到記錄局面的作用了（因為它的內容不斷的被更新，而我們查找的時候根本找不到過去的局面），可多大行呢，這不好說，除非你設置的置換錶和你能夠經歷的局面相等，呵呵，整個硬盤作為虛擬內存都未必夠用，估計初始化置換錶就要很久很久……所以這個”適當“的值，很難說，我的做法是：設置一個盡量大的值，這可以減少重複提高效率，而前提是，初始化過程，不超過1秒。我的計算機可以初始化1<<24這麼多，而不會超過一秒。所以我就設置了這麼大一個置換錶。
' 模板長度
Public len As Integer
' 模板含有棋子數
Private pipecount As Integer
' 模板
Private infow As Integer
Private infob As Integer
' 模板返回值
Public value As Integer
' 適用於本模板的信息截斷
Private make As Integer
例如，在模板New mMod({0, 1, 1, 1, 1, 0}, 42)中，
模板長度：6，也就是說，這個模板將檢測向量中連續6位。
模板含有棋子數：4
infow和infob這是白棋和黑棋模板，它們被new函數根據傳入數組初始化。
value是模闆對應的棋型，也就是上面new函數中的42。
make是掩碼信息，它用於把向量的棋型當中無用的（前面）部分去掉。
new函數是這樣的：
Sub New(bs() As Byte, val As Integer)
len = bs.Length
pipecount = val \ 10
value = val
For i = 0 To bs.Length - 1
infow = infow << 2
infob = infob << 2
If bs(i) = 1 Then
infow = infow Or CInt(1)
infob = infob Or CInt(2)
End If
make = make Or (CInt(1) << (i * 2)) '遮蔽，把模板中用到的位都置1。所以只需要对信息进行AND操作，就可以去掉信息中无用部分。
make = make Or (CInt(1) << (i * 2 + 1))
Next
End Sub
inf0 = vector.info >> (i * 2) '逐两位进行比较
inf0 = inf0 And make '将无用信息去掉
If inf0 = infow Then '符合模板
vector.value(0) = value '记录模板值
vector.update(0) = False '已符合，无需继续扫描
End If
Public Shared Sub Evaluate(ByRef vector As mVector)
If vector.info <> 0 Then
Dim i, ilen As Integer
For i = 0 To AllMod.Length - 1
ilen = AllMod(i).len
If vector.len >= ilen Then '若向量长度不小于模板长度
AllMod(i).CompareMod(vector)
If vector.update(0) = False AndAlso vector.update(1) = False Then
Return
End If
End If
Next
End If
If vector.update(0) Then
vector.value(0) = 0
vector.update(0) = False
End If
If vector.update(1) Then
vector.value(1) = 0
vector.update(1) = False
End If
End Sub
'是否需要更新
Public update(1) As Boolean
'转换表
Private table(224) As Byte
'向量上的棋型
Public info As Integer
'向量长度
Public len As Integer
'向量上白棋、黑棋的个数
Public pipecount(1) As Byte
'向量上白棋、黑棋的棋型
Public value(1) As Byte
'向量方向
Private Direction As Integer
'坐标表
Public points() As Byte
Sub New(ps As Byte(), dir As Integer)
points = ps
Direction = dir
len = ps.Length
For i = 0 To ps.Length - 1
table(ps(i)) = i '转换表的下标对应着在points的值，而值对应下标在points中的位置。
Next
End Sub
'mvs为全部合理招法
Function GenerateMoves(ByRef mvs() As Byte, mv As Integer) As Integer '生成所有走法
'临时变量，存储当前局面下每个子周围三格以内的空位
Dim tmp As BitArray = GetGeneratePoints()
Dim offset As Integer = 0
If mv > -1 Then
tmp.Set(mv, False)
offset = 1
End If
'统计全部空位
Dim i As Integer = 0, nGenMoves As Integer = offset
For i = 0 To 224
If tmp(i) Then
mvs(offset + nGenMoves) = i
nGenMoves += 1
End If
Next
Return nGenMoves - 1
End Function
' 保存置换表项
Sub RecordHash(nFlag As Integer, vl As Integer, nDepth As Integer, mv As Integer)
'被替换的置换表
Dim hshtindex As Integer = -1
Dim hsh, hsh0, hsh1 As mHashItem
'===============================置换表覆盖策略=================================
'0、查找空的，直接覆盖。若没有空的：
'分别找到置换表0、1当中对应的元素，
'1、若元素完全符合某一个，则
'1.1、若深度更深，则直接覆盖
'1.2、否则，退出
'2、若不完全符合任何一个，则
'2.1、若深度比置换表中深度更浅的深，则覆盖这个
'2.2、否则，退出
hsh0 = hstb0(mVectorManeger.keys(0) And mConstValue.HASH_SIZE_S1) '提取
If hsh0.dwLock_a = 0 Then '若为空，直接覆盖
hshtindex = 0
Else '不为空
'若一致
If (hsh0.dwLock_a = mVectorManeger.keys(1)) AndAlso (hsh0.dwLock_b = mVectorManeger.keys(2)) AndAlso (hsh0.dwLock_c = mVectorManeger.keys(3)) Then
If hsh0.ucDepth < nDepth Then '若深度更大则更新
hshtindex = 0
Else '若深度更小则返回
Return
End If
End If
'若不一致，查找下一个
End If
If hshtindex = -1 Then
hsh1 = hstb1(mVectorManeger.keys(1) And mConstValue.HASH_SIZE_S1)
If hsh1.dwLock_a = 0 Then
hshtindex = 1
Else
If (hsh1.dwLock_a = mVectorManeger.keys(0)) AndAlso (hsh1.dwLock_b = mVectorManeger.keys(2)) AndAlso (hsh1.dwLock_c = mVectorManeger.keys(3)) Then
If hsh1.ucDepth < nDepth Then
hshtindex = 1
Else
Return
End If
End If
End If
End If
'若没有找到空的、完全符合的，则覆盖深度更小的。
If hshtindex = -1 Then
If hsh0.ucDepth < hsh1.ucDepth Then
If hsh0.ucDepth < nDepth Then hshtindex = 0
Else
If hsh1.ucDepth < nDepth Then hshtindex = 1
End If
End If
'若没有深度更小的，那么不记录。
If hshtindex = -1 Then
Return
End If
If hshtindex = 0 Then hsh = hsh0 Else hsh = hsh1
hsh.ucFlag = nFlag
hsh.ucDepth = nDepth
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.dwLock_b = mVectorManeger.keys(2)
hsh.dwLock_c = mVectorManeger.keys(3)
If hshtindex = 0 Then
hsh.dwLock_a = mVectorManeger.keys(1)
hstb0(mVectorManeger.keys(0) And mConstValue.HASH_SIZE_S1) = hsh
Else
hsh.dwLock_a = mVectorManeger.keys(0)
hstb0(mVectorManeger.keys(1) And mConstValue.HASH_SIZE_S1) = hsh
End If
c += 1
End Sub
'獲取設置指定點上的棋子後轉化成的形態
Public Function NextShape(mlmd As mShape, point As Integer, player As Integer) As mShape
Return mlmd.sMod(point * 3 + player)
End Function
'默認形態
Public Function defShape() As mShape
Return list(242)
End Function
End Class
Public Class mShape
Public PointValues(4) As Integer '各點棋子（0=無子，1=己方，2=對方）。
Public sMod(14) As mShape '轉換結果
Public Player As Integer '所屬玩家
Public type As mConstValue.LinkType '棋型類型
Sub New(pvs() As Byte, tp As mConstValue.LinkType)
Dim i, w, b As Integer
For i = 0 To 4
PointValues(i) = pvs(i)
If pvs(i) = 0 Then
w += 1
ElseIf pvs(i) = 1 Then
b += 1
End If
Next
Player = 2
If w = 0 AndAlso b > 0 Then Player = 1
If w > 0 AndAlso b = 0 Then Player = 0
type = tp
End Sub
Public Overrides Function Equals(obj As Object) As Boolean
Dim tmp As mShape = obj
Return tmp.PointValues(0) = Me.PointValues(0) AndAlso tmp.PointValues(1) = Me.PointValues(1) AndAlso tmp.PointValues( 2) = Me.PointValues(2) AndAlso tmp.PointValues(3) = Me.PointValues(3) AndAlso tmp.PointValues(4) = Me.PointValues(4)
End Function
新浪微博
QQ空间
人人网
腾讯微博
Facebook
Google+
Plurk
Twitter
Line