全局變量定義
type hrdstate '華容道的棋局表示
state(1 to 12) as long '棋盤上的12個棋子的當前位置
superid as long '上一步棋盤的位置編號,0代表無上一步
level as long '這一不棋局的級別,0代表是開始狀態(tài)
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 '棋子的開始狀態(tài),接收輸入值
dim es(1 to 12) as long '棋子的計算結束狀態(tài),生成輸出值,中間變量
dim hnum as long '橫放的將軍的數(shù)量,輸入值
public iendnum as long '計算結束的下一步的數(shù)量,輸出值
dim saveend(1 to 240) as long '最后生成的存放結果數(shù)組,輸出值
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) '初始狀態(tài)
next i
hnum = beginhnum '橫放的將軍數(shù)量
iendnum = 0 '初始化結果數(shù)量為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數(shù)組中的數(shù)據(jù)添加到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
'初始化下一步的數(shù)據(jù)
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初始化下一步的數(shù)據(jù)
dim i as long
for i = 1 to 12
es(i) = bs(i)
next i
movecaocao = -1 '初始化返回值,-1代表不成功
'up按照規(guī)則,限制曹操不能向上移動
'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
'初始化下一步的數(shù)據(jù)
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
'初始化下一步的數(shù)據(jù)
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 保存已經(jīng)走過的節(jié)點記錄類
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 = "節(jié)點數(shù):" & 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 "初始狀態(tài)不合法，請檢查!"
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
'判斷是否可以結束循環(huán)
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 "行走步數(shù)：" & g_save.icurrentnum &
"用時: " & i, vbokonly, "恭喜恭喜，行走成功"
else
msgbox "行走步數(shù)：" & 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
