Using VB to solve the source code of Huarong Road problem

Solve | problem | Source code global variable definition




Type hrdstate ' Huarong Road Chess representation
Current position of 12 pieces on the state (1 to) as Long ' chessboard
Superid as Long ' the position number of the chessboard, 0 represents no previous step
Level as Long ' This is not a chess rank, 0 represents the starting state
End Type
Public G_next as Chrdnext
Public G_save as Chrdsave
Public G_state as Hrdstate




Application Startup




Sub Main ()
Frmhrdmain.show ' Show main window
End Sub
Class </b> of the next algorithm for <b>chrdnext encapsulation calculation
Dim BS (1 to) as Long ' The starting state of the pawn, receive input value
The computed end state of the Dim ES (1 to) as Long ' pieces, generating output values, intermediate variables
Dim Hnum as Long ' The number of generals placed horizontally, input values
Public Iendnum as Long ' calculates the next number of ends, output value
Dim Saveend (1 to +) as Long ' last generated array of stored results, output value
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 ' moves direction
Dim iend as Long ' records move results
For i = 1 to 12
BS (i) = BeginState (i) ' initial state
Next I
Hnum = Beginhnum ' Horizontal General number
Iendnum = 0 ' initialization result number is 0
If Movecaocao () = 0 Then addend
For i = 2 to Hnum + 1 ' move sideways general
For movetype = 1 to 4
If Movehtiger (Movetype, i) = 0 Then addend
Next Movetype
Next I
For i = Hnum + 2 to 6 ' Move vertical general
For movetype = 1 to 4
If Movevtiger (Movetype, i) = 0 Then addend
Next Movetype
Next I
For i = 7 to 10 ' moving pawns
For movetype = 1 to 4
If Movefighter (Movetype, i) = 0 Then addend
Next Movetype
Next I
End Sub
Private Sub Addend ()
' Adds the data in the end array to the saveend, and finally adds a iendnum value of 1
Dim I as Long
For i = 1 to 12
Saveend (Iendnum * + i) = ES (i)
Next I
Iendnum = iendnum + 1
End Sub
Private Sub sortend (Beginid as Long, endid as Long)
' The output will be sorted to ensure that the small person in the front, the big in the rear
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
' Initialize the next data
Dim I as Long
For i = 1 to 12
ES (i) = BS (i)
Next I
Movefighter =-1 ' initialization return value
Select Case Move_type
Case 1 ' Up
If es (one) = es (ID)-4 Then
ES (id) = es (ID)-4:es (one) = es (11) + 4
Movefighter = 0:goto Sort
End If
If es (in) = es (ID)-4 Then
ES (id) = es (ID)-4:es (a) = es (12) + 4
Movefighter = 0:goto Sort
End If
Case 2 ' Down
If es (one) = es (ID) + 4 Then
ES (id) = es (ID) + 4:es (one) = es (11)-4
Movefighter = 0:goto Sort
End If
If es (in) = es (ID) + 4 Then
ES (id) = es (ID) + 4:es () = es (12)-4
Movefighter = 0:goto Sort
End If
Case 3 ' left
If es (one) = es (ID)-1 and ES (one) Mod 4 <> 0 Then
ES (id) = es (ID)-1:es (one) = es (11) + 1
Movefighter = 0:goto Sort
End If
If es (in) = es (ID)-1 and ES (Mod) 4 <> 0 Then
ES (id) = es (ID)-1:es (a) = es (12) + 1
Movefighter = 0:goto Sort
End If
Case 4 ' right
If es (one) = es (ID) + 1 and es (one) Mod 4 <> 1 Then
ES (id) = es (ID) + 1:es (one) = es (11)-1
Movefighter = 0:goto Sort
End If
If es (in) = es (ID) + 1 and es () Mod 4 <> 1 Then
ES (id) = es (ID) + 1:es () = es (12)-1
Movefighter = 0:goto Sort
End If
End Select
Sort:
If movefighter = 0 Then
Sortend 7, 10 ' sort of pawns
Sortend 11, 12 ' sort spaces
End If
End Function
Private Function Movecaocao () as Long
' Step1 initializes the next data
Dim I as Long
For i = 1 to 12
ES (i) = BS (i)
Next I
Movecaocao =-1 ' initialization return value,-1 represents unsuccessful
' Up in accordance with the rules, to limit the devil can not move up
' If es (one) = es (1)-8 and es () = es (one) + 1 Then
' es (1) = es (1)-4:es (one) = es (one) + 8:es (12)
= ES (12) + 8
' Movecaocao = 0
' End If
' Down
If es (one) = es (1) + 8 and es (a) = es (one) + 1 Then
ES (1) = es (1) + 4:es (one) = es (one)-8:es (12)
= ES (12)-8
Movecaocao = 0:goto Sort
End If
' Left
If es (one) = es (1)-1 and ES (12)
= es (one) + 4 and (es (one) Mod 4) <> 0 Then
ES (1) = es (1)-1:es (one) = es (one) + 2:es (a) = es (12) + 2
Movecaocao = 0:goto Sort
End If
' Right
If es (one) = es (1) + 2 and es (12)
= es (one) + 4 and (es (one) Mod 4) <> 1 Then
ES (1) = es (1) + 1:es (one) = es (one)-2:es (a) = es (12)-2
Movecaocao = 0:goto Sort

End If
' After moving the devil, you don't need to sort it again.
Sort:
' Do nothing
End Function
Private Function Movehtiger (movetype as long, id as long)
As Long
' Initialize the next data
Dim I as Long
For i = 1 to 12
ES (i) = BS (i)
Next I
Movehtiger =-1 ' Set initial value
Select Case Movetype
Case 1 ' Up
If es (one) = es (ID)-4 and es (in) = es (one) + 1 Then
ES (id) = es (ID)-4:es (one) = es (one) + 4:es (a) = es (12) + 4
Movehtiger = 0:goto Sort
End If
Case 2 ' Down
If es (one) = es (ID) + 4 and es (in) = es (one) + 1 Then
ES (id) = es (ID) + 4:es (one) = es (one)-4:es (a) = es (12)-4
Movehtiger = 0:goto Sort
End If
Case 3 ' left
If es (one) = es (ID)-1 and ES (one) Mod 4 <> 0 Then
ES (id) = es (ID)-1:es (one) = es (11) + 2
Movehtiger = 0:goto Sort
End If
If es (in) = es (ID)-1 and ES (Mod) 4 <> 0 Then
ES (id) = es (ID)-1:es (a) = es (12) + 2
Movehtiger = 0:goto Sort
End If
Case 4 ' right
If es (one) = es (ID) + 2 and es (one) Mod 4 <> 1 Then
ES (id) = es (ID) + 1:es (one) = es (11)-2
Movehtiger = 0:goto Sort
End If
If es (in) = es (ID) + 2 and es () Mod 4 <> 1 Then
ES (id) = es (ID) + 1:es () = es (12)-2
Movehtiger = 0:goto Sort
End If
End Select
Sort:
If Movehtiger = 0 Then
Sortend 2, Hnum + 1 ' horizontal put generals sort
Sortend 11, 12 ' space sort
End If
End Function
Private Function Movevtiger (movetype as long, id as long) as long
' Initialize the next data
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 (one) = es (ID)-4 Then
ES (id) = es (ID)-4:es (one) = es (11) +
8:movevtiger = 0:goto Sort
End If
If es (in) = es (ID)-4 Then
ES (id) = es (ID)-4:es (a) = es (12) +
8:movevtiger = 0:goto Sort
End If
Case 2 ' Down
If es (one) = es (ID) + 8 Then
ES (id) = es (ID) + 4:es (one) = es (11)-
8:movevtiger = 0:goto Sort
End If
If es (in) = es (ID) + 8 Then
ES (id) = es (ID) + 4:es (a) = es (12)-
8:movevtiger = 0:goto Sort
End If
Case 3 ' left
If es (one) = es (ID)-1 and es (in) = es (11) +
4 and ES (one) Mod 4 <> 0 Then
ES (id) = es (ID)-1:es (one) = es (11) +
1:es (+) = ES (12) + 1
Movevtiger = 0:goto Sort
End If
Case 4 ' right
If es (one) = es (ID) + 1 and es (a) = es (11) +
4 and ES (one) Mod 4 <> 1 Then
ES (id) = es (ID) + 1:es (one) = es (11)-
1:es (+) = ES (12)-1
Movevtiger = 0:goto Sort
End If
End Select
Sort:
If Movevtiger = 0 Then
Sortend Hnum + 2, 6 ' Vertical release generals sort
Sortend 11, 12 ' space sort
End If
End Function




Chrdsave Save the node record class that has been traversed




Option Explicit
Dim SaveState (1 to 300000) as Hrdstate ' up to 30,000 steps
Public icurrentnum as Long ' current position pointer
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 (a) = NewState (a) 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




Code for the main interface form




Private Sub Showid (id as long, deep as long)
Label1.Caption = "Number of nodes:" & CStr (ID) & "Test depth:" & CStr (Deep)
End Sub
Private Function IsValid (state () as long, ByVal hnum as Long)
Dim BS (1 to) 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 ' Caocao
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 ' Sideways general
BS (k) = 0
BS (k + 1) = 0
Else ' The vertical general
BS (k) = 0
BS (k + 4) = 0
End If
Case 7, 8, 9, 10, 11, 12 ' pawns and spaces
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) 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 "Initial state is illegal, please check!"
Exit Sub
End If
Set G_next = New Chrdnext
Set G_save = New Chrdsave
G_save.addstate beginstate, 0, 0 ' to the final record.
i = 1
Do While I <= g_save.icurrentnum ' stack not complete
' Read the current record
G_save.getstate I
Showid I, G_state.level
' Determine if you can end the loop
If g_state.state (1) = Then
G_save.icurrentnum = i
Exit do
End If
' Calculate all subordinate steps
G_next.getnext G_state.state, Ihnum
j = 1
Do While J <= G_next.iendnum
' Next assignment
For k = 1 to 12
BeginState (k) = G_next.getid (J * 12-12 + k)
Next K
' Into the queue
G_save.addstate beginstate, I, G_state.level + 1
j = j + 1
Loop
i = i + 1
If I Mod = 0 Then DoEvents
Loop
Time2 = Now ()
i = (time2-time1) * 3600 * 24
G_save.getstate G_save.icurrentnum
If g_state.state (1) = Then
MsgBox "Walking Step Number:" & G_save.icurrentnum &
"When:" & I, vbOKOnly, "Congratulations congratulations, walking success"
Else
MsgBox "Walking Step Number:" & G_save.icurrentnum &
"Spents:" & I, vbOKOnly, "Sorry, walk failed"
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) <> Then
MsgBox "didn't find a reasonable solution."
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 ' Exit program
End Sub