plo plo - プログラム倉庫

Function prefer(s As Single, th, p) As Single
Dim m As Single
Dim maxm As Single
Dim maxu As Single
Dim u1 As Single
Dim p1 As Single
maxu = -999
For m = 0 To 10
p1 = p(m)
u1 = u(s, th, m, p1)
If u1 > maxu Then maxm = m
If u1 > maxu Then maxu = u1
Next
prefer = maxm
End Function

Function u(s As Single, th, q1 As Single, tr As Single) As Single
Dim x1 As Single
x1 = q1
pp = 0
If x1 < 0 Then pp = 1
If pp = 1 Then x1 = 0
u1 = th(s) * Log(x1 + 1) - tr
If pp = 1 Then u1 = -999
u = u1
End Function

Private Sub Command1_Click()
Dim m As Single
Dim s As Single
Dim p(0 To 10) As Single
Dim th(1 To 10) As Single
Dim gr(1 To 10) As Single
Dim rev(1 To 9, -1 To 1, -1 To 1, -1 To 1) As Single
Dim fast(-1 To 1) As Single
Dim sec(-1 To 1, -1 To 1) As Single
Dim n1 As Single
Dim n2 As Single
Dim n3 As Single
Dim h As Single
Dim p1 As Single
Dim p2 As Single
Dim p3 As Single
Dim maxm As Single

For s = 1 To 10
th(s) = s
Next
For m = 1 To 10
p(m) = 2 * m
Next
For s = 1 To 10
m = prefer(s, th, p)
gr(s) = m
Next
h = 0.1
For m = 2 To 9
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
p1 = p(m - 1) + n1 * h
p2 = p(m) + n2 * h
p3 = p(m + 1) + n3 * h
r2 = 0
For s = 1 To 10
u1 = u(s, th, m - 1, p1)
u2 = u(s, th, m, p2)
u3 = u(s, th, m + 1, p3)
maxu = u2
maxm = m
If u1 > maxu Then maxm = m - 1
If u1 > maxu Then maxu = u1
If u3 > maxu Then maxm = m + 1
If u3 > maxu Then maxu = u3
If maxm = m - 1 Then r1 = p1 - cost * maxm
If maxm = m Then r1 = p2 - cost * maxm
If maxm = m + 1 Then r1 = p3 - cost * maxm
If gr(s) = m Then r2 = r2 + r1
Next
rev(m, n1, n2, n3) = r2
Next
Next
Next
Debug.Print rev(m, 0, 0, 0)
Next
For n1 = -1 To 1
p1 = p(1) + n1 * h
For s = 1 To 10
u1 = u(s, th, 0, 0)
u2 = u(s, th, 1, p1)
maxu = u1
maxm = 0
If u2 > maxu Then maxm = 1
r1 = 0
If maxm = 1 Then r1 = p1 - cost * maxm
If gr(s) = 0 Then r2 = r2 + r1
Next
fast(n1) = r2
Debug.Print n1, fast(n1)
If maxm = m - 1 Then r1 = p(maxm) - cost * maxm
Next
For n1 = -1 To 1
For n2 = 1 To 1
p1 = p(1) + n1 * h
p2 = p(2) + n2 * h
For s = 1 To 10
u1 = u(s, th, 0, 0)
u2 = u(s, th, 1, p1)
u3 = u(s, th, 2, p2)
maxu = u1
maxm = 0
If u2 > maxu Then maxm = 1
If u2 > maxu Then maxu = u2
If u3 > maxu Then maxm = 2
r1 = 0
If maxm = 1 Then r1 = p1 - cost * maxm
If maxm = 2 Then r1 = p1 - cost * maxm
If gr(s) = 1 Then r2 = r2 + r1
Next
sec(n1, n2) = r2
Debug.Print n1, n2, sec(n1, n2)
Next
Next

End Sub