上一篇写了一个深度学习源代码，大家很喜欢，没得到的点这里：
《》这一篇，再写一个强化学习源代码。
很简单，只需把下面的代码复制粘贴到Excel中，按下面的步骤运行程序，你会看到一只老鼠会自动学会用最短路径走迷宫。
首先打开Excel软件，新建一个空白表格。然后按 Alt+F11 组合键，打开编程窗口。
右侧的窗口是程序窗口，请按照图中标示①②的顺序，点开小框中的“+”号变为“-”号，再双击“Sheet1”，把光标移到③处单击，就可以向里面粘贴程序代码了。（代码附后）
粘贴完成后，按F5键运行程序。请选择运行“主程序”。
对源代码的完整解读在这里（点击可入）：
《》 《》 《》'（以下是强化学习源代码，请从下一行开始复制到末尾）
Const MazeRow0 = 4 '迷宫左上角行号
Const MazeCol0 = 2 '迷宫左上角列号
Const ThetaRow0 = 4 '动作参数表θ左上角行号
Const ThetaCol0 = 8 '动作参数表θ左上角列号
Const PiRow0 = 16 '动作策略表π左上角行号
Const PiCol0 = 2 '动作策略表π左上角列号
Const QRow0 = 16 '动作价值表Q左上角行号
Const QCol0 = 8 '动作价值表Q左上角列号
Sub 主程序()
Dim Episode As Integer '运行轮次
Range(Cells(MazeRow0, MazeCol0), Cells(MazeRow0 + 4, MazeCol0 + 3)).Clear '清空迷宫区域
初始化
Episode = 10 'Cells(ParaRow0 + 5, ParaCol0 + 3).Value
For ep = 1 To Episode
画迷宫
延时 (0.5) '延时0.5秒
Cells(MazeRow0 - 1, MazeCol0 + 0).Value = "训练次数："
Cells(MazeRow0 - 1, MazeCol0 + 1).Value = ep '写训练次数
Cells(MazeRow0 - 1, MazeCol0 + 1).Font.ColorIndex = 5 '蓝色
Cells(MazeRow0 - 1, MazeCol0 + 1).Font.FontStyle = "Bold" '粗体
Range(Cells(ThetaRow0, ThetaCol0), Cells(ThetaRow0 + 8, ThetaCol0 + 3)).Font.ColorIndex = 1 'θ表黑色
Range(Cells(PiRow0, PiCol0), Cells(PiRow0 + 8, PiCol0 + 3)).Font.ColorIndex = 1 'π表黑色
Range(Cells(QRow0, QCol0), Cells(QRow0 + 8, QCol0 + 3)).Font.ColorIndex = 1 'Q表黑色
' 随机行走 '随机走迷宫
强化学习
Next ep
End Sub
Sub 初始化()
Dim 列号 As Integer
For 列号 = 1 To 20
Cells(1, 列号).Value = 列号
Cells(1, 列号).Font.ColorIndex = 5 '蓝色
Next 列号
Cells(MazeRow0 - 2, MazeCol0 + 1) = "老鼠走迷宫"
Cells(MazeRow0 - 2, MazeCol0 + 1).Font.ColorIndex = 16 '深灰色
画迷宫
画动作参数表
画策略表
画价值表
End Sub
Sub 画迷宫() '画迷宫
Dim i As Integer
Dim j As Integer
Dim s As Integer '迷宫位置的编号
With Range(Cells(MazeRow0, MazeCol0), Cells(MazeRow0 + 2, MazeCol0 + 2))
.Borders(xlEdgeTop).LineStyle = xlDouble '双线边框
.Borders(xlEdgeRight).LineStyle = xlDouble '双线边框
.Borders(xlEdgeLeft).LineStyle = xlDouble '双线边框
.Borders(xlEdgeBottom).LineStyle = xlDouble '双线边框
End With
Cells(MazeRow0 + 0, MazeCol0 + 0).Borders(xlEdgeRight).LineStyle = xlDouble '双线边框
Cells(MazeRow0 + 1, MazeCol0 + 0).Borders(xlEdgeBottom).LineStyle = xlDouble '双线边框
Cells(MazeRow0 + 1, MazeCol0 + 2).Borders(xlEdgeBottom).LineStyle = xlDouble '双线边框
Cells(MazeRow0 + 1, MazeCol0 + 1).Borders(xlEdgeTop).LineStyle = xlDouble '双线边框
Cells(MazeRow0 + 1, MazeCol0 + 2).Borders(xlEdgeBottom).LineStyle = xlDouble '双线边框
s = 0
For i = 0 To 2 '行号
For j = 0 To 2 '列号
Cells(i + MazeRow0, j + MazeCol0).Value = Str(s) '写迷宫位置的编号
Cells(i + MazeRow0, j + MazeCol0).Font.ColorIndex = 15 '灰色
Cells(i + MazeRow0, j + MazeCol0).Font.FontStyle = "Bold" '粗体
s = s + 1
Next j
Next i
Cells(MazeRow0, MazeCol0).Value = "老鼠"
Cells(MazeRow0, MazeCol0).Font.ColorIndex = 1 '黑色
Cells(MazeRow0 + 2, MazeCol0 + 2).Value = "食物" '在S8放食物奖励
Cells(MazeRow0 + 2, MazeCol0 + 2).Font.ColorIndex = 3 '红色
' Cells(MazeRow0 + 0, MazeCol0 + 1).Value = "食物" '在S1放食物奖励
' Cells(MazeRow0 + 0, MazeCol0 + 1).Font.ColorIndex = 3 '红色
End Sub
Sub 画动作参数表() '画迷宫的动作参数表(θ)
Dim i As Integer '行号
Dim j As Integer '列号
Dim s As Integer '迷宫位置编号
Dim ThetaRow As Integer '动作参数表当前行号
Dim ThetaCol As Integer '动作参数表当前列号
Range(Cells(ThetaRow0 - 2, ThetaCol0 - 1), Cells(ThetaRow0 + 8, ThetaCol0 + 4)).Clear '清空动作参数表区域
Cells(ThetaRow0 - 2, ThetaCol0 + 1).Value = "动作参数表θ（动作数字化）"
Cells(ThetaRow0 - 2, ThetaCol0 + 1).Font.ColorIndex = 5 '蓝色
Cells(ThetaRow0 - 2, ThetaCol0 + 1).Font.FontStyle = "Bold" '粗体
'画动作参数表表头
Cells(ThetaRow0 - 2, ThetaCol0 - 1) = "位置编号/"
Cells(ThetaRow0 - 2, ThetaCol0 - 1).Font.FontStyle = "Bold" '粗体
Cells(ThetaRow0 - 1, ThetaCol0 - 1) = "移动方向"
Cells(ThetaRow0 - 1, ThetaCol0 - 1).Font.FontStyle = "Bold" '粗体
Cells(ThetaRow0 - 1, ThetaCol0 + 0) = " 上"
Cells(ThetaRow0 - 1, ThetaCol0 + 1) = " 右"
Cells(ThetaRow0 - 1, ThetaCol0 + 2) = " 下"
Cells(ThetaRow0 - 1, ThetaCol0 + 3) = " 左"
s = 0
For i = 0 To 2
For j = 0 To 2
ThetaRow = ThetaRow0 + i * 3 + j '动作参数表行号
Cells(ThetaRow, ThetaCol0 - 1) = Str(s) '写动作参数表位置S的序号
With Cells(i + MazeRow0, j + MazeCol0)
If .Borders(xlEdgeTop).LineStyle = -4142 Then '如果上方无边框
Cells(ThetaRow, ThetaCol0 + 0) = 1 '动作值为1
Cells(ThetaRow, ThetaCol0 + 0).Font.FontStyle = "Bold" '设字体为粗体
Else
Cells(ThetaRow, ThetaCol0 + 0) = 0 '动作值为0
Cells(ThetaRow, ThetaCol0 + 0).Font.ColorIndex = 15 '灰色
Cells(ThetaRow, ThetaCol0 + 0).Font.FontStyle = "Bold" '设字体为粗体
End If
If .Borders(xlEdgeRight).LineStyle = -4142 Then '如果右方无边框
Cells(ThetaRow, ThetaCol0 + 1) = 1
Cells(ThetaRow, ThetaCol0 + 1).Font.FontStyle = "Bold" '设字体为粗体
Else
Cells(ThetaRow, ThetaCol0 + 1) = 0
Cells(ThetaRow, ThetaCol0 + 1).Font.ColorIndex = 15 '灰色
Cells(ThetaRow, ThetaCol0 + 1).Font.FontStyle = "Bold" '设字体为粗体
End If
If .Borders(xlEdgeBottom).LineStyle = -4142 Then '如果下方无边框
Cells(ThetaRow, ThetaCol0 + 2) = 1
Cells(ThetaRow, ThetaCol0 + 2).Font.FontStyle = "Bold" '设字体为粗体
Else
Cells(ThetaRow, ThetaCol0 + 2) = 0
Cells(ThetaRow, ThetaCol0 + 2).Font.ColorIndex = 15 '灰色
Cells(ThetaRow, ThetaCol0 + 2).Font.FontStyle = "Bold" '设字体为粗体
End If
If .Borders(xlEdgeLeft).LineStyle = -4142 Then '如果左方无边框
Cells(ThetaRow, ThetaCol0 + 3) = 1
Cells(ThetaRow, ThetaCol0 + 3).Font.FontStyle = "Bold" '设字体为粗体
Else '其他情况，即有边框
Cells(ThetaRow, ThetaCol0 + 3) = 0 '动作值为0
Cells(ThetaRow, ThetaCol0 + 3).Font.ColorIndex = 15 '灰色
Cells(ThetaRow, ThetaCol0 + 3).Font.FontStyle = "Bold" '设字体为粗体
End If
End With
s = s + 1 '编号+1
Next j
Next i
With Range(Cells(ThetaRow0, ThetaCol0), Cells(ThetaRow0 + 8, ThetaCol0 + 3))
.Borders(xlEdgeTop).LineStyle = xlContinuous '画顶部单线边框
.Borders(xlEdgeRight).LineStyle = xlContinuous '画右侧单线边框
.Borders(xlEdgeLeft).LineStyle = xlContinuous '画左侧单线边框
.Borders(xlEdgeBottom).LineStyle = xlContinuous '画底部单线边框
End With
End Sub
Sub 画策略表() '
Dim SumTheta(10) As Single '每个位置的动作状态θ之和
Dim Pi(4, 9) As Single '策略π：动作概率
Dim i As Integer, j As Integer
' Dim Sum1 As Single 'Pi表中每个位置动作状态之和
Dim 随机数 As Single '随机数
Randomize (Timer) '初始化随机数
Range(Cells(PiRow0 - 2, PiCol0 - 1), Cells(PiRow0 + 8, PiCol0 + Intv + 3)).Clear '清空策略表区域
Cells(PiRow0 - 2, PiCol0 + 1).Value = "动作策略表π（动作概率化）"
Cells(PiRow0 - 2, PiCol0 + 1).Font.ColorIndex = 5 '蓝色
Cells(PiRow0 - 2, PiCol0 + 1).Font.FontStyle = "Bold" '粗体
'画动作策略表表头
Cells(PiRow0 - 2, PiCol0 - 1) = "位置编号/"
Cells(PiRow0 - 2, PiCol0 - 1).Font.FontStyle = "Bold" '粗体
Cells(PiRow0 - 1, PiCol0 - 1) = "移动方向"
Cells(PiRow0 - 1, PiCol0 - 1).Font.FontStyle = "Bold" '粗体
Cells(PiRow0 - 1, PiCol0 + 0) = " 上" '画出策略表动作的序号
Cells(PiRow0 - 1, PiCol0 + 1) = " 右" '画出策略表动作的序号
Cells(PiRow0 - 1, PiCol0 + 2) = " 下" '画出策略表动作的序号
Cells(PiRow0 - 1, PiCol0 + 3) = " 左" '画出策略表动作的序号
With Range(Cells(PiRow0, PiCol0), Cells(PiRow0 + 8, PiCol0 + 3))
.Borders(xlEdgeTop).LineStyle = xlContinuous '画策略表顶边单线边框
.Borders(xlEdgeRight).LineStyle = xlContinuous '画策略表右边单线边框
.Borders(xlEdgeLeft).LineStyle = xlContinuous '画策略表左边单线边框
.Borders(xlEdgeBottom).LineStyle = xlContinuous '画策略表底边单线边框
End With
For j = 0 To 8
Cells(j + PiRow0, PiCol0 - 1).Value = j '写Pi表状态S的序号
For i = 0 To 3
SumTheta(j) = Application.Sum(Range(Cells(ThetaRow0 + j, ThetaCol0), Cells(ThetaRow0 + j, ThetaCol0 + 3)))
Pi(i, j) = Cells(j + ThetaRow0, i + ThetaCol0).Value / SumTheta(j)
Cells(j + PiRow0, i + PiCol0).Value = Pi(i, j) '填表：策略π--动作概率
If Pi(i, j) = 0 Then
Cells(j + PiRow0, i + PiCol0).Font.ColorIndex = 15 '0为灰色
Cells(j + PiRow0, i + PiCol0).Font.FontStyle = "Bold"
Else
Cells(j + PiRow0, i + PiCol0).Font.ColorIndex = 1 '黑色
Cells(j + PiRow0, i + PiCol0).Font.FontStyle = "Bold"
End If
Next i
Next j
End Sub
Sub 随机行走()
Dim MsRow As Integer, MsCol As Integer '老鼠位置行列号
Dim StaRow As Integer '每个位置在参数表中的序号
Dim 表列号 As Integer
'初始位置
MsRow = MazeRow0
MsCol = MazeCol0
Do While True
延时 (0.08) '延时0.08秒
Cells(MsRow, MsCol).Value = "" '移动老鼠
StaRow = (MsRow - MazeRow0) * 3 + (MsCol - MazeCol0) '
表列号 = 策略表选择(StaRow)
取下一步位置 表列号, MsRow, MsCol '取得下一步的位置
If Cells(MsRow, MsCol).Value = "食物" Then
Cells(MsRow, MsCol).Value = "老鼠"
Cells(MazeRow0 + 2, MazeCol0 + 2).Font.ColorIndex = 5 '蓝色
延时 (0.5) '延时0.5秒
Exit Do
End If
Cells(MsRow, MsCol).Value = "老鼠"
Cells(MsRow, MsCol).Font.ColorIndex = 1 '黑色
Loop
End Sub
Function 策略表选择(pStaRow As Integer) As Integer '按策略表选择动作
Dim 随机数 As Single '随机数
Dim 下限 As Single
Dim 上限 As Single
Dim 表列号 As Integer '策略表列号（表内）
Randomize (Timer)
随机数 = Rnd()
'按照策略参数表中的动作概率选择移动方向
下限 = 0
上限 = 0
For 表列号 = 0 To 3
If 表列号 = 0 Then
下限 = 0
Else
下限 = 下限 + Cells(pStaRow + PiRow0, 表列号 + PiCol0 - 1).Value
End If
上限 = 上限 + Cells(pStaRow + PiRow0, 表列号 + PiCol0).Value
If 随机数 > 下限 And 随机数 <= 上限 Then
策略表选择 = 表列号 '返回策略表列号（表内）
Cells(pStaRow + PiRow0, 表列号 + PiCol0).Font.ColorIndex = 7 '粉色
Exit For
End If
Next 表列号
End Function
Sub 取下一步位置(Drct As Integer, ByRef SRow As Integer, ByRef SCol As Integer) '获取下一步的位置
Dim Pi(4, 9) As Single
Dim i As Integer, j As Integer
Dim StaRow As Integer '每个位置在参数表中的序号'
StaRow = (SRow - MazeRow0) * 3 + (SCol - MazeCol0) '
Select Case Drct
Case 0 '"0上"
SRow = SRow - 1
Case 1 '"1右"
SCol = SCol + 1
Case 2 '"2下"
SRow = SRow + 1
Case 3 '"3左"
SCol = SCol - 1
End Select
Cells(ThetaRow0 + StaRow, ThetaCol0 + Drct).Font.ColorIndex = 7 '粉色
End Sub
Sub 延时(T As Single)
Dim time1 As Single
time1 = Timer
Do
DoEvents
Loop While Timer - time1 < T
End Sub
Sub 画价值表() '画价值表（Q表）
Dim SumTheta(10) As Single '每个位置的动作状态θ之和
Dim Q(4, 9) As Single 'Q价值表
Dim TDEr(4, 9) As Single 'TD误差表
Dim i As Integer, j As Integer
Dim 随机数 As Single '随机数
Dim Q0 As Single 'Q初值系数
Q0 = 0.1 'Q初值系数
Randomize (Timer)
Range(Cells(QRow0 - 2, QCol0 - 1), Cells(QRow0 + 8, QCol0 + 4)).Clear '清空Q表区域
Cells(QRow0 - 2, QCol0 + 1).Value = "动作价值表Q（动作价值化）"
Cells(QRow0 - 2, QCol0 + 1).Font.ColorIndex = 5 '蓝色
Cells(QRow0 - 2, QCol0 + 1).Font.FontStyle = "Bold" '粗体
'画动作价值表表头
Cells(QRow0 - 2, QCol0 - 1) = "位置编号/"
Cells(QRow0 - 2, QCol0 - 1).Font.FontStyle = "Bold" '粗体
Cells(QRow0 - 1, QCol0 - 1) = "移动方向"
Cells(QRow0 - 1, QCol0 - 1).Font.FontStyle = "Bold" '粗体
Cells(QRow0 - 1, QCol0 + 0) = " 上" '写Q表动作a的序号
Cells(QRow0 - 1, QCol0 + 1) = " 右" '写Q表动作a的序号
Cells(QRow0 - 1, QCol0 + 2) = " 下" '写Q表动作a的序号
Cells(QRow0 - 1, QCol0 + 3) = " 左" '写Q表动作a的序号
With Range(Cells(QRow0, QCol0), Cells(QRow0 + 8, QCol0 + 3))
.Borders(xlEdgeTop).LineStyle = xlContinuous '单线边框
.Borders(xlEdgeRight).LineStyle = xlContinuous '单线边框
.Borders(xlEdgeLeft).LineStyle = xlContinuous '单线边框
.Borders(xlEdgeBottom).LineStyle = xlContinuous '单线边框
End With
For j = 0 To 8
Cells(j + QRow0, QCol0 - 1).Value = j '写Q表状态S的序号
For i = 0 To 3
If Cells(j + ThetaRow0, i + ThetaCol0).Value <> 0 Then
Do While True '取非0随机数
随机数 = Rnd()
If 随机数 <> 0 Then Exit Do
Loop
Q(i, j) = 随机数 * Q0 'Q取随机数，可乘0.1~1之间的系数
Cells(j + QRow0, i + QCol0).Value = Q(i, j) '填表：Q--随机动作
Cells(j + QRow0, i + QCol0).Font.ColorIndex = 1 '黑色
Cells(j + QRow0, i + QCol0).Font.FontStyle = "Bold"
Else
Cells(j + QRow0, i + QCol0).Value = 0
Cells(j + QRow0, i + QCol0).Font.ColorIndex = 16 '0为灰色
Cells(j + QRow0, i + QCol0).Font.FontStyle = "Bold"
End If
Next i
Next j
End Sub
Function 价值表选择(pStaRow As Integer) As Integer '按价值表选择价值最大的动作
Dim 最大价值 As Single
Dim 当前价值 As Single '指定范围随机数
Dim 表列号 As Integer '价值表列号（表内）
最大价值 = Application.Max(Range(Cells(QRow0 + pStaRow, QCol0), Cells(QRow0 + pStaRow, QCol0 + 3))) '求价值表中最大值
For 表列号 = 0 To 3
当前价值 = Cells(pStaRow + QRow0, 表列号 + QCol0).Value
If 当前价值 = 最大价值 Then
价值表选择 = 表列号 '最大价值对应表内列号
Exit For
End If
Next 表列号
End Function
Function 策略价值方向(ByRef SRow As Integer, ByRef SCol As Integer, Epsilon As Single) As Integer '获取下一步的动作
Dim Drct As Integer 'String '表内列号
Dim StaRow As Integer '当前位置在状态表中的行号
Dim CRnd As Single '动作随机数
Randomize (Timer)
CRnd = Rnd()
StaRow = (SRow - MazeRow0) * 3 + (SCol - MazeCol0)
If CRnd > Epsilon Then
'一部分按照策略π表中的动作概率随机选移动方向
Drct = 策略表选择(StaRow)
Else
'另一部分选择价值Q表中的最大价值的方向
Drct = 价值表选择(StaRow)
End If
取下一步位置 Drct, SRow, SCol '取得下一步的位置
策略价值方向 = Drct
End Function
Sub 强化学习() '根据算法Alg走迷宫
Dim MsRow1 As Integer, MsCol1 As Integer '老鼠移动前位置行列号
Dim MsRow2 As Integer, MsCol2 As Integer '老鼠移动后位置行列号
Dim i As Double
Dim Alpha As Single '学习率
Dim Gamma As Single '折扣率
Dim Epsilon As Single 'ε-贪婪法初值（探索/利用比率）
Dim R As Single '奖励值
Dim StaRow1 As Integer '当前位置编号（参数表行号）
Dim StaRow2 As Integer '下一个位置编号（参数表行号）
Dim QCol1 As Integer '当前位置在Q表中的列号
Dim QCol2 As Integer '下一个位置在Q表中的列号
Dim QValue1 As Single '当前位置在Q表中的价值
Dim Qvalue2 As Single '下一位置在Q表中的价值
Dim Drct As String '行进方向
Dim NextQValue As Single '下一个位置的Q值
Alpha = 0.1 '学习率，取值（0～1）；越大学习越快
Gamma = 0.9 '折扣率，取值（0～1）；
Epsilon = 0.5 '价值表占比，取值（0～1）；取0全策略（随机），取1全价值
'初始位置
MsRow2 = MazeRow0
MsCol2 = MazeCol0
StaRow2 = (MsRow2 - MazeRow0) * 3 + (MsCol2 - MazeCol0) '+ 3 '老鼠当前位置编号
Cells(MsRow2, MsCol2).Value = "" '擦掉旧老鼠
QCol2 = 策略价值方向(MsRow2, MsCol2, Epsilon) '取得第一步的方向
Qvalue2 = Cells(QRow0 + StaRow2, QCol0 + QCol2).Value '取得当前的Q值
Cells(QRow0 + StaRow2, QCol0 + QCol2).Font.ColorIndex = 7 '粉色读出
StaRow1 = StaRow2
QCol1 = QCol2
Do While True
MsRow1 = MsRow2 '保留移动前老鼠位置
MsCol1 = MsCol2
StaRow1 = StaRow2 '保留移动前Q值位置
QCol1 = QCol2
QValue1 = Qvalue2 '保留移动前的Q值
Cells(StaRow1 + QRow0, QCol1 + QCol0).Font.ColorIndex = 5 '移动前的Q值，蓝色读出
If Cells(MsRow2, MsCol2) = "食物" Then '到达食物奖励点
R = 1
'更新移动前Q表中的价值
Cells(StaRow1 + QRow0, QCol1 + QCol0).Value = QValue1 + Alpha * (R - QValue1)
Cells(StaRow1 + QRow0, QCol1 + QCol0).Font.ColorIndex = 3 '红色写入
Cells(MsRow2, MsCol2).Value = "老鼠" '画出新老鼠
Cells(MsRow2, MsCol2).Font.ColorIndex = 5 '蓝色
延时 (0.5) '延时0.5秒
Exit Do
Else
R = 0
StaRow2 = (MsRow2 - MazeRow0) * 3 + (MsCol2 - MazeCol0) '+ 3 '老鼠当前位置编号
QCol2 = 策略价值方向(MsRow2, MsCol2, Epsilon) '取得下一步的动作列号
'Q-Learning算法
Qvalue2 = Application.Max(Range(Cells(StaRow2 + QRow0, QCol0), Cells(StaRow2 + QRow0, QCol0 + 3))) '求最大值
Cells(StaRow1 + QRow0, QCol1 + QCol0) = QValue1 + Alpha * (R + Gamma * Qvalue2 - QValue1)
Cells(StaRow1 + QRow0, QCol1 + QCol0).Font.ColorIndex = 3 '红色写入
Cells(MsRow1, MsCol1).Value = "" '擦掉旧老鼠
If Cells(MsRow2, MsCol2).Value <> "食物" Then '如果该位置有"食物"则不画老鼠
Cells(MsRow2, MsCol2).Value = "老鼠" '画出新老鼠
Cells(MsRow2, MsCol2).Font.ColorIndex = 1 '黑色
End If
End If
延时 (0.05) '延时0.05秒
Loop
End Sub