使用VB求解“华容道”问题

liujunsong

浏览: 76065 次
性别:
来自: 北京

最近访客更多访客>>

蜉蝣eye

u011119025

qdusunstar

a983549160

博主相关

博客

微博

相册

留言

关于我

文章分类

社区版块

存档分类

博客分类：

华容道解法
源码天地

VB 华容道

由于年代久远，此文本地已经无存，网上临时找到一篇备份，录在下面。

收录的网站本身已经没有图片了，真是遗憾，以后有空再补充下。

概述：本文描述了利用广度优先算法求解“华容道”问题的基本思路，以及根据最短路径原理对深度优先算法进行优化，从而提高了算法的执行效率，本文所提出的优化算法同样可以利用于同样类型的问题求解。

1、问题的提出1.1“华容道”简介 “华容道”是一种中国古代的智力游戏玩具，在一个宽为4，长为5的矩形框中，有10个棋子，包括一个曹操，五虎上将，四个小卒，要求在各个棋子不重叠的情况下进行移动，最有将曹操从棋盘上方移动到下边中央为成功。由于五员大将可以横放也可以竖放，有许多种排列方法，因而可以形成非常复杂的棋局，人们还给常用的棋局起了很多好听的名字，例如下图就是“横刀立马”的布局图。

图1.1 “横刀立马”的布局

关于此问题的求解方法，现在已经有许多文章详细描述，本文不再一一描述，专门针对“广度优先算法”方式解题进行讨论。 1.2广度优先算法的讨论 我们知道，对于类似于“华容道”的问题，例如迷宫问题等，都可以归结为图论中图的遍历和最短路径问题。也就是说，从某一个具体状态开始作为图的起点，每走出任意一步以后得到的状态作为这个节点的延伸，只要保证每次走出的状态不和原来已经走过的状态相重复，那么就可以遍历所有由此原始状态可能到达的所有状态，从而形成一张完整的倒立放置的树图，如下图所示意。

图1.2 状态转化示意图

针对“华容道”问题，其实质在于如何快速构建这样一张状态树图，在数据量未知的情况下，保证快速找到最终的结果。要做到这一点，有许多算法，广度优先是其中比较流行的一种算法。其具体思路是：由起点出发，先构建第一层的节点，然后依次构建第二层，第三层节点，在构建的过程中，为了保证数据不重复出现，需要对每一个新节点都和原来已经生成的所有节点进行比较，保证其不重复出现在图中。问题则由此而产生，由于在每次增加新节点时，都需要和原来所有的节点进行比较以保证此节点不重复出现，随着节点数量的增加，每次需要进行的比较也不断增加，这样就需要进行大量的时间用于比较状态是否重复，从而形成算法效率的一个瓶颈。这也是有人认为广度优先算法效率低下的一个重要原因。下面将讨论如何优化广度优先算法以提高效率。 2、广度优先算法的优化 我们现在假设已经找到了一条从起始点状态到最终结果状态的一条最短路径，那么我们显然可以得到如下的推论：从起始点到此最短路径上的每一个具体状态，所走的路径都是针对此节点状态的最短路径。也就是说，我们要找到从起点到终点的最短路径，只能够通过行走每个节点的最短路径来得到。我们现在给图中的每一个节点，都标示上其对应的最短路径步数，形成如同下图的一张带有路径步数的节点状态树图。

图2.1 带有最短路径步数的状态树图

结合上图，我们可以很容易得到如下的结论：在最短路径树图中，与任何级别为n的节点相连的节点，其级别必然在[n-1,n+1]之间。（结论1）那么，从一个级别为n的节点出发，得到的所有节点，其级别也只能在(n-1,n+1)之间。因此，得到如下的结论：要判断从一个原始级别为n的节点产生的节点是否在图中已经存在，仅需要判断图中[n-1,n+1]级别的节点集合中是否有此节点即可，如果没有，那么此节点就是新节点。（结论2）请注意上面所描述的结论2，根据结论2，在对于新产生节点是否重复的判断问题上，仅需要由本级节点上溯到上二极即可，而不需要一直上溯到最开始的节点。这样，通过缩小对于新产生节点是否存在的判断范围，我们达到了对于广度优先算法的优化目的。 3、结论 在广度优先算法的搜索过程中，如果按照最短路径的规则进行搜索，那么对于每次搜索产生的新节点状态，只需要在其上两层进行回溯判断，就可以判断新节点状态是否重复，从而达到快速搜索的目的。这种对于广度优先算法的优化同样可以用于其它类似问题的求解，例如“八皇后问题”，迷宫行走问题，最短交通路线问题等等。 -----------------------------------------------------------------

附录:源程序代码 “华容道解题大师1。0”采用Visual Basic6.0开发。下述代码都以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

分享到：

superset安装过程 | 进销存系统的通用模型

2018-02-13 13:42
浏览 572
评论(0)
分类:编程语言
查看更多

发表评论

您还没有登录,请您登录后再发表评论

最近访客更多访客>>

博主相关

文章分类

社区版块

存档分类

最新评论