欢迎光临
我们一直在努力

利用VB解决华容道问题的源代码-.NET教程,VB.Net语言

建站超值云服务器,限时71元/月

全局变量定义

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

赞(0)
版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com 特别注意:本站所有转载文章言论不代表本站观点! 本站所提供的图片等素材,版权归原作者所有,如需使用,请与原作者联系。未经允许不得转载:IDC资讯中心 » 利用VB解决华容道问题的源代码-.NET教程,VB.Net语言
分享到: 更多 (0)

相关推荐

  • 暂无文章