和尚、妖怪过河VBA版（数据结构、递归）

lsdongjh · 发表于 2019-12-23 16:10

根据核心算法，用VBA实现了一下

Option Explicit
'状态
Type ItemState
local_monster As Integer '本地妖怪数
local_monk As Integer '本地和尚数
remote_monster As Integer '对岸妖怪数
remote_monk As Integer '对岸和尚数
BoatLocation As Boolean '船的位置本地True,对岸 False
EffectName As String '动作名称
End Type
'动作
Type ActionEffect
local_monster_move As Integer '本地妖怪移动数
local_monk_move As Integer '本地和尚移动数
remote_monster_move As Integer '对岸妖怪移动数
remote_monk_move As Integer '对岸和尚移动数
Boat_To As Boolean '船的移动方向往本地True,往对岸 False
ActiveName As String '动作名称
End Type
'和尚、妖怪初始数
Const MONK_COUNT As Long = 3
Const MONSTER_COUNT As Long = 3
'=========================================================
'主过程
Sub Main()
Dim myState(0) As ItemState
With myState(0)
.local_monk = MONK_COUNT
.local_monster = MONSTER_COUNT
.remote_monk = 0
.remote_monster = 0
.BoatLocation = True
End With
ProcessState myState
MsgBox "OK"
'【结果】
',[3-3-0-0],TWO_MONSTER_GO[3-1-0-2],ONE_MONSTER_BACK[3-2-0-1],TWO_MONSTER_GO[3-0-0-3],ONE_MONSTER_BACK[3-1-0-2],TWO_MONK_GO[1-1-2-2],ONE_MONSTER_ONE_MONK_BACK[2-2-1-1],TWO_MONK_GO[0-2-3-1],ONE_MONSTER_BACK[0-3-3-0],TWO_MONSTER_GO[0-1-3-2],ONE_MONSTER_BACK[0-2-3-1],TWO_MONSTER_GO[0-0-3-3]
',[3-3-0-0],TWO_MONSTER_GO[3-1-0-2],ONE_MONSTER_BACK[3-2-0-1],TWO_MONSTER_GO[3-0-0-3],ONE_MONSTER_BACK[3-1-0-2],TWO_MONK_GO[1-1-2-2],ONE_MONSTER_ONE_MONK_BACK[2-2-1-1],TWO_MONK_GO[0-2-3-1],ONE_MONSTER_BACK[0-3-3-0],TWO_MONSTER_GO[0-1-3-2],ONE_MONK_BACK[1-1-2-2],ONE_MONSTER_ONE_MONK_GO[0-0-3-3]
',[3-3-0-0],ONE_MONSTER_ONE_MONK_GO[2-2-1-1],ONE_MONK_BACK[3-2-0-1],TWO_MONSTER_GO[3-0-0-3],ONE_MONSTER_BACK[3-1-0-2],TWO_MONK_GO[1-1-2-2],ONE_MONSTER_ONE_MONK_BACK[2-2-1-1],TWO_MONK_GO[0-2-3-1],ONE_MONSTER_BACK[0-3-3-0],TWO_MONSTER_GO[0-1-3-2],ONE_MONSTER_BACK[0-2-3-1],TWO_MONSTER_GO[0-0-3-3]
',[3-3-0-0],ONE_MONSTER_ONE_MONK_GO[2-2-1-1],ONE_MONK_BACK[3-2-0-1],TWO_MONSTER_GO[3-0-0-3],ONE_MONSTER_BACK[3-1-0-2],TWO_MONK_GO[1-1-2-2],ONE_MONSTER_ONE_MONK_BACK[2-2-1-1],TWO_MONK_GO[0-2-3-1],ONE_MONSTER_BACK[0-3-3-0],TWO_MONSTER_GO[0-1-3-2],ONE_MONK_BACK[1-1-2-2],ONE_MONSTER_ONE_MONK_GO[0-0-3-3]
End Sub
'=========================================================
'逐个动作判断、递归
Function ProcessState(mState() As ItemState)
Dim ActionEffects() As ActionEffect
Dim CurState() As ItemState, lngID As Long
CurState = mState
If IsFinalState(CurState) Then
Debug.Print PrintResult(CurState) '在立即窗口输出结果
Exit Function
End If
ActionEffects = InicAE
For lngID = 0 To 9
ProcessStateOnNewAction CurState, ActionEffects(lngID)
Next
End Function
'=========================================================
'判断某个动作是否可行，并执行
Function ProcessStateOnNewAction(mState() As ItemState, act As ActionEffect)
Dim CurState() As ItemState
CurState = mState
If CanTakeAction(CurState, act) Then
SetItemState CurState, act
ProcessState CurState
End If
End Function
'=========================================================
'输出结果
Function PrintResult(mState() As ItemState) As String
Dim strTemp As String, lngID As Long
For lngID = LBound(mState) To UBound(mState)
strTemp = strTemp & "," & mState(lngID).EffectName & "[" & mState(lngID).local_monk & "-" & mState(lngID).local_monster & "-" & mState(lngID).remote_monk & "-" & mState(lngID).remote_monster & "]"
Next
PrintResult = strTemp
End Function
'=========================================================
' 初始化动作
Function InicAE() As ActionEffect()
Dim AE(9) As ActionEffect
AE(0) = InicActionEffect(-1, 0, 1, 0, False, "ONE_MONSTER_GO")
AE(1) = InicActionEffect(-2, 0, 2, 0, False, "TWO_MONSTER_GO")
AE(2) = InicActionEffect(0, -1, 0, 1, False, "ONE_MONK_GO")
AE(3) = InicActionEffect(0, -2, 0, 2, False, "TWO_MONK_GO")
AE(4) = InicActionEffect(-1, -1, 1, 1, False, "ONE_MONSTER_ONE_MONK_GO")
AE(5) = InicActionEffect(1, 0, -1, 0, True, "ONE_MONSTER_BACK")
AE(6) = InicActionEffect(2, 0, -2, 0, True, "TWO_MONSTER_BACK")
AE(7) = InicActionEffect(0, 1, 0, -1, True, "ONE_MONK_BACK")
AE(8) = InicActionEffect(0, 2, 0, -2, True, "TWO_MONK_BACK")
AE(9) = InicActionEffect(1, 1, -1, -1, True, "ONE_MONSTER_ONE_MONK_BACK")
InicAE = AE
End Function
Function InicActionEffect(local_monster_move As Integer, local_monk_move As Integer, remote_monster_move As Integer, remote_monk_move As Integer, Boat_To As Boolean, ActiveName As String) As ActionEffect
InicActionEffect.local_monster_move = local_monster_move
InicActionEffect.local_monk_move = local_monk_move
InicActionEffect.remote_monster_move = remote_monster_move
InicActionEffect.remote_monk_move = remote_monk_move
InicActionEffect.Boat_To = Boat_To
InicActionEffect.ActiveName = ActiveName
End Function
'=========================================================
'设置状态
Function SetItemState(ByRef mState() As ItemState, act As ActionEffect)
Dim lngLastID As Long, State As ItemState
lngLastID = UBound(mState) + 1
ReDim Preserve mState(lngLastID)
State.local_monster = mState(lngLastID - 1).local_monster + act.local_monster_move
State.local_monk = mState(lngLastID - 1).local_monk + act.local_monk_move
State.remote_monster = mState(lngLastID - 1).remote_monster + act.remote_monster_move
State.remote_monk = mState(lngLastID - 1).remote_monk + act.remote_monk_move
State.BoatLocation = act.Boat_To
State.EffectName = act.ActiveName
mState(lngLastID) = State
End Function
'=========================================================
'是否成功
Function IsFinalState(mState() As ItemState) As Boolean
Dim lngLastID As Long, State As ItemState
lngLastID = UBound(mState)
State = mState(lngLastID)
If State.remote_monk = MONK_COUNT And State.remote_monster = MONSTER_COUNT Then
IsFinalState = True
Else
IsFinalState = False
End If
End Function
'=========================================================
'是否可以移动
Function CanTakeAction(mState() As ItemState, act As ActionEffect) As Boolean
Dim lngLastID As Long, State As ItemState, NextState As ItemState
lngLastID = UBound(mState)
State = mState(lngLastID)
If act.Boat_To = State.BoatLocation Then
CanTakeAction = False
Exit Function
End If
With NextState
.local_monk = State.local_monk + act.local_monk_move
.local_monster = State.local_monster + act.local_monster_move
.remote_monk = State.remote_monk + act.remote_monk_move
.remote_monster = State.remote_monster + act.remote_monster_move
.BoatLocation = act.Boat_To
End With
If NextState.local_monk < 0 Or NextState.local_monster < 0 Or NextState.remote_monk < 0 Or NextState.remote_monster < 0 Then
CanTakeAction = False
Exit Function
End If
If ((NextState.local_monk < NextState.local_monster) And NextState.local_monk > 0) Or ((NextState.remote_monk < NextState.remote_monster) And NextState.remote_monk > 0) Then
CanTakeAction = False
Exit Function
End If
For lngLastID = LBound(mState) To UBound(mState)
State = mState(lngLastID)
If State.BoatLocation = NextState.BoatLocation And _
State.local_monk = NextState.local_monk And _
State.local_monster = NextState.local_monster And _
State.remote_monk = NextState.remote_monk And _
State.remote_monster = NextState.remote_monster Then
CanTakeAction = False
Exit Function
End If
Next
CanTakeAction = True
End Function

复制代码

koala219 · 发表于 2019-12-23 16:19

虽然我看不懂，但觉得很高大上。
除了膜拜，暂时没有其他的应对方式。

lsdongjh · 发表于 2019-12-24 09:23

将动作枚举数组改为全局变量

Option Explicit
'状态
Type ItemState
local_monster As Integer '本地妖怪数
local_monk As Integer '本地和尚数
remote_monster As Integer '对岸妖怪数
remote_monk As Integer '对岸和尚数
BoatLocation As Boolean '船的位置本地True,对岸 False
EffectName As String '动作名称
End Type
'动作
Type ActionEffect
local_monster_move As Integer '本地妖怪移动数
local_monk_move As Integer '本地和尚移动数
remote_monster_move As Integer '对岸妖怪移动数
remote_monk_move As Integer '对岸和尚移动数
Boat_To As Boolean '船的移动方向往本地True,往对岸 False
ActiveName As String '动作名称
End Type
'和尚、妖怪初始数
Const MONK_COUNT As Long = 3
Const MONSTER_COUNT As Long = 3
'动作组，用于枚举
Dim ActionEffects() As ActionEffect
'记录有效的方法数
Dim lngTotal As Long
'=========================================================
'主过程
Sub Main()
Dim myState(0) As ItemState
'初始化状态
With myState(0)
.local_monk = MONK_COUNT
.local_monster = MONSTER_COUNT
.remote_monk = 0
.remote_monster = 0
.BoatLocation = True
End With
'初始化动作组
ActionEffects = InicAE
lngTotal = 0
ProcessState myState
MsgBox "路径计算完毕，共有【 " & lngTotal & " 】条"
End Sub
'=========================================================
'逐个动作判断、递归
Function ProcessState(mState() As ItemState)
Dim CurState() As ItemState, lngID As Long
CurState = mState
If IsFinalState(CurState) Then
lngTotal = lngTotal + 1
Debug.Print PrintResult(CurState) '在立即窗口输出结果
Exit Function
End If
For lngID = 0 To 9
ProcessStateOnNewAction CurState, ActionEffects(lngID)
Next
End Function
'=========================================================
'判断某个动作是否可行，并执行
Function ProcessStateOnNewAction(mState() As ItemState, act As ActionEffect)
Dim CurState() As ItemState
CurState = mState
If CanTakeAction(CurState, act) Then
SetItemState CurState, act
ProcessState CurState
End If
End Function
'=========================================================
'输出结果
Function PrintResult(mState() As ItemState) As String
Dim strTemp As String, lngID As Long
For lngID = LBound(mState) To UBound(mState)
strTemp = strTemp & "," & mState(lngID).EffectName & "[" & mState(lngID).local_monk & "-" & mState(lngID).local_monster & "-" & mState(lngID).remote_monk & "-" & mState(lngID).remote_monster & "]"
Next
PrintResult = strTemp
End Function
'=========================================================
' 初始化动作
Function InicAE() As ActionEffect()
Dim AE(9) As ActionEffect
AE(0) = InicActionEffect(-1, 0, 1, 0, False, "ONE_MONSTER_GO")
AE(1) = InicActionEffect(-2, 0, 2, 0, False, "TWO_MONSTER_GO")
AE(2) = InicActionEffect(0, -1, 0, 1, False, "ONE_MONK_GO")
AE(3) = InicActionEffect(0, -2, 0, 2, False, "TWO_MONK_GO")
AE(4) = InicActionEffect(-1, -1, 1, 1, False, "ONE_MONSTER_ONE_MONK_GO")
AE(5) = InicActionEffect(1, 0, -1, 0, True, "ONE_MONSTER_BACK")
AE(6) = InicActionEffect(2, 0, -2, 0, True, "TWO_MONSTER_BACK")
AE(7) = InicActionEffect(0, 1, 0, -1, True, "ONE_MONK_BACK")
AE(8) = InicActionEffect(0, 2, 0, -2, True, "TWO_MONK_BACK")
AE(9) = InicActionEffect(1, 1, -1, -1, True, "ONE_MONSTER_ONE_MONK_BACK")
InicAE = AE
End Function
Function InicActionEffect(local_monster_move As Integer, local_monk_move As Integer, remote_monster_move As Integer, remote_monk_move As Integer, Boat_To As Boolean, ActiveName As String) As ActionEffect
InicActionEffect.local_monster_move = local_monster_move
InicActionEffect.local_monk_move = local_monk_move
InicActionEffect.remote_monster_move = remote_monster_move
InicActionEffect.remote_monk_move = remote_monk_move
InicActionEffect.Boat_To = Boat_To
InicActionEffect.ActiveName = ActiveName
End Function
'=========================================================
'设置状态
Function SetItemState(ByRef mState() As ItemState, act As ActionEffect)
Dim lngLastID As Long, State As ItemState
lngLastID = UBound(mState) + 1
ReDim Preserve mState(lngLastID)
State.local_monster = mState(lngLastID - 1).local_monster + act.local_monster_move
State.local_monk = mState(lngLastID - 1).local_monk + act.local_monk_move
State.remote_monster = mState(lngLastID - 1).remote_monster + act.remote_monster_move
State.remote_monk = mState(lngLastID - 1).remote_monk + act.remote_monk_move
State.BoatLocation = act.Boat_To
State.EffectName = act.ActiveName
mState(lngLastID) = State
End Function
'=========================================================
'是否成功
Function IsFinalState(mState() As ItemState) As Boolean
Dim lngLastID As Long, State As ItemState
lngLastID = UBound(mState)
State = mState(lngLastID)
If State.remote_monk = MONK_COUNT And State.remote_monster = MONSTER_COUNT Then
IsFinalState = True
Else
IsFinalState = False
End If
End Function
'=========================================================
'是否可以移动
Function CanTakeAction(mState() As ItemState, act As ActionEffect) As Boolean
Dim lngLastID As Long, State As ItemState, NextState As ItemState
lngLastID = UBound(mState)
State = mState(lngLastID)
If act.Boat_To = State.BoatLocation Then
CanTakeAction = False
Exit Function
End If
With NextState
.local_monk = State.local_monk + act.local_monk_move
.local_monster = State.local_monster + act.local_monster_move
.remote_monk = State.remote_monk + act.remote_monk_move
.remote_monster = State.remote_monster + act.remote_monster_move
.BoatLocation = act.Boat_To
End With
If NextState.local_monk < 0 Or NextState.local_monster < 0 Or NextState.remote_monk < 0 Or NextState.remote_monster < 0 Then
CanTakeAction = False
Exit Function
End If
If ((NextState.local_monk < NextState.local_monster) And NextState.local_monk > 0) Or ((NextState.remote_monk < NextState.remote_monster) And NextState.remote_monk > 0) Then
CanTakeAction = False
Exit Function
End If
For lngLastID = LBound(mState) To UBound(mState)
State = mState(lngLastID)
If State.BoatLocation = NextState.BoatLocation And _
State.local_monk = NextState.local_monk And _
State.local_monster = NextState.local_monster And _
State.remote_monk = NextState.remote_monk And _
State.remote_monster = NextState.remote_monster Then
CanTakeAction = False
Exit Function
End If
Next
CanTakeAction = True
End Function

复制代码

		自动登录	找回密码
密码			免费注册

[原创] 和尚、妖怪过河VBA版（数据结构、递归）

评分