利用VB解决华容道问题的源代码

王朝vb·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

全局变量定义

Type HRDState '华容道的棋局表示

state(1 To 12) As Long '棋盘上的12个棋子的当前位置

Superid As Long '上一步棋盘的位置编号,0代表无上一步

Level As Long '这一不棋局的级别,0代表是开始状态

End Type

Public G_Next As CHRDNext

Public G_Save As CHRDSave

Public G_State As HRDState

应用程序启动

Sub Main()

frmHRDMAIN.Show '显示主窗口

End Sub

<B>CHRDNext封装计算下一步算法的类</b>

Dim bs(1 To 12) As Long '棋子的开始状态,接收输入值

Dim ES(1 To 12) As Long '棋子的计算结束状态,生成输出值,中间变量

Dim hnum As Long '横放的将军的数量,输入值

Public iEndNum As Long '计算结束的下一步的数量,输出值

Dim SaveEnd(1 To 240) As Long '最后生成的存放结果数组,输出值

Public Function getid(id As Long) As Long

getid = SaveEnd(id)

End Function

Public Sub GetNext(BEGINSTATE() As Long, BEGINHNUM As Long)

Dim i As Long

Dim MoveType As Long '移动方向

Dim iend As Long '记录移动结果

For i = 1 To 12

bs(i) = BEGINSTATE(i) '初始状态

Next i

hnum = BEGINHNUM '横放的将军数量

iEndNum = 0 '初始化结果数量为0

If MoveCaoCao() = 0 Then AddEnd

For i = 2 To hnum + 1 '移动横放的将军

For MoveType = 1 To 4

If MoveHtiger(MoveType, i) = 0 Then AddEnd

Next MoveType

Next i

For i = hnum + 2 To 6 '移动竖放的将军

For MoveType = 1 To 4

If MoveVtiger(MoveType, i) = 0 Then AddEnd

Next MoveType

Next i

For i = 7 To 10 '移动小卒

For MoveType = 1 To 4

If MoveFighter(MoveType, i) = 0 Then AddEnd

Next MoveType

Next i

End Sub

Private Sub AddEnd()

'将End数组中的数据添加到SaveEnd中去,最后将iendnum的值加1

Dim i As Long

For i = 1 To 12

SaveEnd(iEndNum * 12 + i) = ES(i)

Next i

iEndNum = iEndNum + 1

End Sub

Private Sub SortEnd(BeginId As Long, EndId As Long)

'将输出结果进行排序,保证小者在前,大者在后

Dim i As Long

Dim j As Long

Dim Swap As Long

i = BeginId

Do While i <= EndId - 1

j = i + 1

Do While j <= EndId

If ES(i) > ES(j) Then

Swap = ES(i): ES(i) = ES(j): ES(j) = Swap

End If

j = j + 1

Loop

i = i + 1

Loop

End Sub

Private Function MoveFighter(move_type As Long, id As Long)

As Long

'初始化下一步的数据

Dim i As Long

For i = 1 To 12

ES(i) = bs(i)

Next i

MoveFighter = -1 '初始化返回值

Select Case move_type

Case 1 'up

If ES(11) = ES(id) - 4 Then

ES(id) = ES(id) - 4: ES(11) = ES(11) + 4

MoveFighter = 0: GoTo Sort

End If

If ES(12) = ES(id) - 4 Then

ES(id) = ES(id) - 4: ES(12) = ES(12) + 4

MoveFighter = 0: GoTo Sort

End If

Case 2 'down

If ES(11) = ES(id) + 4 Then

ES(id) = ES(id) + 4: ES(11) = ES(11) - 4

MoveFighter = 0: GoTo Sort

End If

If ES(12) = ES(id) + 4 Then

ES(id) = ES(id) + 4: ES(12) = ES(12) - 4

MoveFighter = 0: GoTo Sort

End If

Case 3 'left

If ES(11) = ES(id) - 1 And ES(11) Mod 4 <> 0 Then

ES(id) = ES(id) - 1: ES(11) = ES(11) + 1

MoveFighter = 0: GoTo Sort

End If

If ES(12) = ES(id) - 1 And ES(12) Mod 4 <> 0 Then

ES(id) = ES(id) - 1: ES(12) = ES(12) + 1

MoveFighter = 0: GoTo Sort

End If

Case 4 'right

If ES(11) = ES(id) + 1 And ES(11) Mod 4 <> 1 Then

ES(id) = ES(id) + 1: ES(11) = ES(11) - 1

MoveFighter = 0: GoTo Sort

End If

If ES(12) = ES(id) + 1 And ES(12) Mod 4 <> 1 Then

ES(id) = ES(id) + 1: ES(12) = ES(12) - 1

MoveFighter = 0: GoTo Sort

End If

End Select

Sort:

If MoveFighter = 0 Then

SortEnd 7, 10 '对小卒排序

SortEnd 11, 12 '对空格排序

End If

End Function

Private Function MoveCaoCao() As Long

'step1初始化下一步的数据

Dim i As Long

For i = 1 To 12

ES(i) = bs(i)

Next i

MoveCaoCao = -1 '初始化返回值,-1代表不成功

'up按照规则,限制曹操不能向上移动

'If ES(11) = ES(1) - 8 And ES(12) = ES(11) + 1 Then

' ES(1) = ES(1) - 4: ES(11) = ES(11) + 8: ES(12)

= ES(12) + 8

' MoveCaoCao = 0

'end if

'down

If ES(11) = ES(1) + 8 And ES(12) = ES(11) + 1 Then

ES(1) = ES(1) + 4: ES(11) = ES(11) - 8: ES(12)

= ES(12) - 8

MoveCaoCao = 0: GoTo Sort

End If

'left

If ES(11) = ES(1) - 1 And ES(12)

= ES(11) + 4 And (ES(11) Mod 4) <> 0 Then

ES(1) = ES(1) - 1: ES(11) = ES(11) + 2: ES(12) = ES(12) + 2

MoveCaoCao = 0: GoTo Sort

End If

'right

If ES(11) = ES(1) + 2 And ES(12)

= ES(11) + 4 And (ES(11) Mod 4) <> 1 Then

ES(1) = ES(1) + 1: ES(11) = ES(11) - 2: ES(12) = ES(12) - 2

MoveCaoCao = 0: GoTo Sort

End If

'移动曹操以后,不需要重新进行排序

Sort:

'Do nothing

End Function

Private Function MoveHtiger(MoveType As Long, id As Long)

As Long

'初始化下一步的数据

Dim i As Long

For i = 1 To 12

ES(i) = bs(i)

Next i

MoveHtiger = -1 '设置初始值

Select Case MoveType

Case 1 'up

If ES(11) = ES(id) - 4 And ES(12) = ES(11) + 1 Then

ES(id) = ES(id) - 4: ES(11) = ES(11) + 4: ES(12) = ES(12) + 4

MoveHtiger = 0: GoTo Sort

End If

Case 2 'down

If ES(11) = ES(id) + 4 And ES(12) = ES(11) + 1 Then

ES(id) = ES(id) + 4: ES(11) = ES(11) - 4: ES(12) = ES(12) - 4

MoveHtiger = 0: GoTo Sort

End If

Case 3 'left

If ES(11) = ES(id) - 1 And ES(11) Mod 4 <> 0 Then

ES(id) = ES(id) - 1: ES(11) = ES(11) + 2

MoveHtiger = 0: GoTo Sort

End If

If ES(12) = ES(id) - 1 And ES(12) Mod 4 <> 0 Then

ES(id) = ES(id) - 1: ES(12) = ES(12) + 2

MoveHtiger = 0: GoTo Sort

End If

Case 4 'right

If ES(11) = ES(id) + 2 And ES(11) Mod 4 <> 1 Then

ES(id) = ES(id) + 1: ES(11) = ES(11) - 2

MoveHtiger = 0: GoTo Sort

End If

If ES(12) = ES(id) + 2 And ES(12) Mod 4 <> 1 Then

ES(id) = ES(id) + 1: ES(12) = ES(12) - 2

MoveHtiger = 0: GoTo Sort

End If

End Select

Sort:

If MoveHtiger = 0 Then

SortEnd 2, hnum + 1 '横放将领排序

SortEnd 11, 12 '空格排序

End If

End Function

Private Function MoveVtiger(MoveType As Long, id As Long) As Long

'初始化下一步的数据

Dim i As Long

For i = 1 To 12

ES(i) = bs(i)

Next i

MoveVtiger = -1

Select Case MoveType

Case 1 'up

If ES(11) = ES(id) - 4 Then

ES(id) = ES(id) - 4: ES(11) = ES(11) +

8: MoveVtiger = 0: GoTo Sort

End If

If ES(12) = ES(id) - 4 Then

ES(id) = ES(id) - 4: ES(12) = ES(12) +

8: MoveVtiger = 0: GoTo Sort

End If

Case 2 'down

If ES(11) = ES(id) + 8 Then

ES(id) = ES(id) + 4: ES(11) = ES(11) -

8: MoveVtiger = 0: GoTo Sort

End If

If ES(12) = ES(id) + 8 Then

ES(id) = ES(id) + 4: ES(12) = ES(12) -

8: MoveVtiger = 0: GoTo Sort

End If

Case 3 'left

If ES(11) = ES(id) - 1 And ES(12) = ES(11) +

4 And ES(11) Mod 4 <> 0 Then

ES(id) = ES(id) - 1: ES(11) = ES(11) +

1: ES(12) = ES(12) + 1

MoveVtiger = 0: GoTo Sort

End If

Case 4 'right

If ES(11) = ES(id) + 1 And ES(12) = ES(11) +

4 And ES(11) Mod 4 <> 1 Then

ES(id) = ES(id) + 1: ES(11) = ES(11) -

1: ES(12) = ES(12) - 1

MoveVtiger = 0: GoTo Sort

End If

End Select

Sort:

If MoveVtiger = 0 Then

SortEnd hnum + 2, 6 '竖放将领排序

SortEnd 11, 12 '空格排序

End If

End Function

CHRDSave 保存已经走过的节点记录类

Option Explicit

Dim SaveState(1 To 300000) As HRDState '最多走3万步

Public iCurrentNum As Long '当前位置的指针

Private Function IsExist(NewState() As Long, ilevel As Long) As Boolean

IsExist = False

Dim i As Long

For i = iCurrentNum To 1 Step -1

If SaveState(i).Level < ilevel - 2 Then

i = 0: Exit Function

End If

If SaveState(i).state(1) = NewState(1) And _

SaveState(i).state(2) = NewState(2) And _

SaveState(i).state(3) = NewState(3) And _

SaveState(i).state(4) = NewState(4) And _

SaveState(i).state(5) = NewState(5) And _

SaveState(i).state(6) = NewState(6) And _

SaveState(i).state(7) = NewState(7) And _

SaveState(i).state(8) = NewState(8) And _

SaveState(i).state(9) = NewState(9) And _

SaveState(i).state(10) = NewState(10) Then

IsExist = True: i = 0: Exit Function

End If

Next i

End Function

Public Sub AddState(NewState() As Long, isuperid As Long, ilevel As Long)

Dim i As Long

If Not IsExist(NewState, ilevel) Then

iCurrentNum = iCurrentNum + 1

For i = 1 To 12

SaveState(iCurrentNum).state(i) = NewState(i)

Next

SaveState(iCurrentNum).Superid = isuperid

SaveState(iCurrentNum).Level = ilevel

End If

End Sub

Private Sub Class_Initialize()

iCurrentNum = 0

End Sub

Public Function GetState(id As Long)

If id > 0 Then

G_State = SaveState(id)

End If

End Function

主界面窗体的代码

Private Sub ShowId(id As Long, deep As Long)

Label1.Caption = "节点数:" & CStr(id) & " 测试深度:" & CStr(deep)

End Sub

Private Function isvalid(state() As Long, ByVal hnum As Long)

Dim bs(1 To 20) As Integer

Dim i As Integer

Dim k As Integer

'init

For i = 1 To 20

bs(i) = 1

Next

'check

For i = 1 To 12

k = state(i)

Select Case i

Case 1 '曹操

bs(k) = 0

bs(k + 1) = 0

bs(k + 4) = 0

bs(k + 5) = 0

Case 2, 3, 4, 5, 6

If i <= hnum + 1 Then '横放的将军

bs(k) = 0

bs(k + 1) = 0

Else '竖放的将军

bs(k) = 0

bs(k + 4) = 0

End If

Case 7, 8, 9, 10, 11, 12 '小卒和空格

bs(k) = 0

End Select

Next i

isvalid = True

For i = 1 To 20

If bs(i) > 0 Then

isvalid = False

Exit Function

End If

Next i

End Function

Private Sub cmdStart_Click()

Dim BEGINSTATE(1 To 12) As Long

Dim i As Long

Dim j As Long

Dim k As Long

Dim iHnum As Long

Dim time1 As Date

Dim time2 As Date

Dim ifile As Integer

ifile = FreeFile()

time1 = Now()

For i = 1 To 12

BEGINSTATE(i) = Int(Mid(TextBegin.Text, i * 2 - 1, 2))

Next i

iHnum = CLng(txtNum.Text)

If Not isvalid(BEGINSTATE, iHnum) Then

MsgBox "初始状态不合法,请检查!"

Exit Sub

End If

Set G_Next = New CHRDNext

Set G_Save = New CHRDSave

G_Save.AddState BEGINSTATE, 0, 0 '记录到最终的记录中去

i = 1

Do While i <= G_Save.iCurrentNum '堆栈尚未完成

'读入当前记录

G_Save.GetState i

ShowId i, G_State.Level

'判断是否可以结束循环

If G_State.state(1) = 14 Then

G_Save.iCurrentNum = i

Exit Do

End If

'计算所有下级步骤

G_Next.GetNext G_State.state, iHnum

j = 1

Do While j <= G_Next.iEndNum

'下一步赋值

For k = 1 To 12

BEGINSTATE(k) = G_Next.getid(j * 12 - 12 + k)

Next k

'存入队列之中

G_Save.AddState BEGINSTATE, i, G_State.Level + 1

j = j + 1

Loop

i = i + 1

If i Mod 19 = 0 Then DoEvents

Loop

time2 = Now()

i = (time2 - time1) * 3600 * 24

G_Save.GetState G_Save.iCurrentNum

If G_State.state(1) = 14 Then

MsgBox "行走步数:" & G_Save.iCurrentNum &

"用时: " & i, vbOKOnly, "恭喜恭喜,行走成功"

Else

MsgBox "行走步数:" & G_Save.iCurrentNum &

"用时: " & i, vbOKOnly, "抱歉,行走失败"

End If

i=i+1

End Sub

Private Sub Command1_Click()

List1.Clear

Dim i As Long

i = G_Save.iCurrentNum

G_Save.GetState i

If G_State.state(1) <> 14 Then

MsgBox "没有找到合理的解"

Exit Sub

End If

Dim strtemp(1 To 1000) As String

Dim k As Long

j = 1

Do While G_State.Level > 0

strtemp(j) = ""

For k = 1 To 12

strtemp(j) = strtemp(j) & CStr(G_State.state(k)) & "_"

Next k

strtemp(j) = strtemp(j) & "----" & CStr(G_State.Level)

i = G_State.Superid

G_Save.GetState i

j = j + 1

Loop

strtemp(j) = ""

For k = 1 To 12

strtemp(j) = strtemp(j) & CStr(G_State.state(k)) & "_"

Next k

strtemp(j) = strtemp(j) & "----" & CStr(G_State.Level)

For k = j To 1 Step -1

List1.AddItem strtemp(k)

Next k

End Sub

Private Sub Form_Load()

Set G_Next = New CHRDNext

Set G_Save = New CHRDSave

End Sub

Private Sub mnuAbout_Click()

frmAbout.Show

End Sub

Private Sub mnuExit_Click()

End'退出程序

End Sub

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有  導航