python五子棋ai棋力最高_【五子棋AI循序渐进】发布一个完整的有一定棋力的版本（含源码）...

本博文来自于：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