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

全局变量定义




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

原文转自：http://www.ltesting.net