アリさんのケーキ探し ―― とりあえずケーキ見つけて

何度も部屋を移動してもケーキまでたどり着かない場合は無視する、最初からやり直し、という条件をつける。『Excelでわかる機械学習超入門』では10回だった。しかし、10回でたどり着かないことが延々と続くといつまでたっても進まない。条件をちょっと緩和して、15回は移動してもいいことにしよう。それでもだめならやり直し。で、ケーキまでたどり着いたらOK、という風にしてみた。

Sub Q値の修正6の0()

Dim Jou, JouG, JouR, Jou2, JouG2, JouR2 ' 現状態、現行、現列、次状態、次行、次列
Dim Gran, Gran2, IT2, ST1, DR1, st2, Gree
Dim Gaku1, Dis1  ' 学習率と割引率
Dim Ho As Integer ' 次位置の報酬
Dim CQ, NQ, NQ2 ' 現在のQ 値、r+ガンマMaxQ、新しいQ 値
Dim st ' 新Q値の貼り付け場所
Dim MC ' 繰り返しのための変数

Gaku1 = Range("b7")
Dis1 = Range("b6")
st2 = 0
Range("f14") = st2
Gree = 1
Range("b15") = Gree
Range("m2:p10").Copy Range("b21:e29")
Range("i2") = 12

For MC = 1 To 20

Range("b16") = MC

Do While Range("f14") < 16

Range("f16") = Range("h16")
Range("f17") = Range("h17")
Jou = Range("f15")
JouG = Range("f16")
JouR = Range("f17")
JouG2 = Range("h16")
JouR2 = Range("h17")

st2 = Range("f14")
st = Range("i2")

Gran = Rnd()

Range("D18") = Gran

' Greedyで行くか、冒険で行くか、その結果どの方向に行くかを決める
' 行く方向は変数DR1に格納、D24に表示
If Gran >= Range("b15") Then
    Range("e18") = "RE"    ' Greedyで行く場合
    DR1 = Range("a20").Offset(Range("f15"), 6)
    Range("g18") = DR1
    
    Else
    Range("e18") = "IT"    ' 冒険で行く場合
    
    'ST1 現在の状態で移動可能な方向の数
    ST1 = Range("s1").Offset(Range("f15"), 5)
    ' Range("b24") = ST1
    '乱数を使い、何番目の方向に行くかを決定
    Gran2 = Int(Rnd * ST1 + 1)
    ' Range("c24") = Gran2
    DR1 = Range("s1").Offset(Range("f15"), Gran2)
    Range("g18") = DR1

End If

' 行く方向によって、状態の行、列を更新
If DR1 = 1 Then
    JouR2 = JouR + 1
    Range("h17") = JouR2
ElseIf DR1 = 2 Then
    JouG2 = JouG - 1
    Range("h16") = JouG2
ElseIf DR1 = 3 Then
    JouR2 = JouR - 1
    Range("h17") = JouR2
ElseIf DR1 = 4 Then
    JouG2 = JouG + 1
    Range("h16") = JouG2
    
End If

Jou2 = Range("h15")

' 行った方向に応じてQ値を修正
If Jou < 9 Then
    
Ho = Range("d1").Offset(JouG2, JouR2)
Range("j26") = JouG2
Range("j27") = JouR2
Range("j21") = Ho
NQ = Dis1 * Range("a20").Offset(Jou2, 5) + Ho
Range("j22") = NQ
CQ = Range("a20").Offset(Jou, DR1)
Range("j23") = CQ
NQ2 = CQ + Gaku1 * (Ho - CQ)
Range("j24") = NQ2

Range("a20").Offset(Jou, DR1) = NQ2

End If

st2 = st2 + 1
Range("f14") = st2

Range("a14:j29").Copy Cells(14, st)

st = st + 12
Range("i2") = st

    If Jou2 = 9 Then
    Range("b21:e29").Copy Range("m2:p10")
    Exit Do
    End If

Loop

If Jou2 = 9 Then
    Exit For
End If

Range("l14:ha29").Clear

Next MC

End Sub

無意味な変数がたくさん残っているが、今後使うかもしれないからということで置いておきます。
図は、なんとか7回目でケーキに到達したところ。
f:id:chamcham5628:20201024000448p:plain