本博文来自于:http://www.cnblogs.com/zcsor/archive/2012/12/25/2832820.html
经过这半年左右的学习和探索,现在对五子棋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