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

类别:.NET开发 点击:0 评论:0 推荐:

全局变量定义

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://com.8s8s.com/it/it42755.htm