さいｔれ - プログラム倉庫

Private Sub Command1_Click()
Dim s As Single
Dim th(1 To 100) As Single
Dim n As Single
Dim p(1 To 100) As Single
Dim q(1 To 100) As Single
Dim op1(1 To 100) As Single
Dim op2(1 To 100) As Single
Dim rev(1 To 100, -1 To 1, -1 To 1) As Single
Dim u(1 To 100, -1 To 1, -1 To 1) As Single
Dim w(1 To 99, -1 To 1, -1 To 1) As Single
Dim v(1 To 100, -1 To 1, -1 To 1) As Single
Dim goto1(2 To 100, -1 To 1, -1 To 1) As Single
Dim goto2(2 To 100, -1 To 1, -1 To 1) As Single
Dim h As Single
Dim n1 As Single
Dim n2 As Single
Dim r1 As Single
Dim nx1 As Single
Dim nx2 As Single
Dim cost As Single
Dim j As Single
For s = 1 To 100
th(s) = 0.1 * s
Next
Open "c:/lupin.txt" For Input As #1
Do Until EOF(1)
Input #1, a1, a2, a3
s = a1
q(s) = a2
p(s) = a3
Loop
Close #1
cost = 2
h = 0.001
t = 0
Do Until t > 1000
For s = 1 To 100
For n1 = -1 To 1
For n2 = -1 To 1
q1 = q(s) + n1 * h
p1 = p(s) + n2 * h
r1 = p1 - cost * q1
pp = 0
If p1 < 0 Then pp = 1
If q1 < 0 Then pp = 1
j = 0
If q1 = 0 Then j = j + 1
If p1 > 0 Then j = j + 1
If j = 2 Then pp = 1
If pp = 1 Then r1 = -999
rev(s, n1, n2) = r1
Next
Next
Next
For s = 1 To 100
For n1 = -1 To 1
For n2 = -1 To 1
q1 = q(s) + n1 * h
p1 = p(s) + n2 * h
pp = 0
If q1 < 0 Then pp = 1
If pp = 1 Then q1 = 0
u1 = th(s) * Log(q1 + 1) - p1
If pp = 1 Then u1 = -999
u(s, n1, n2) = u1
Next
Next
Next
For s = 1 To 99
For n1 = -1 To 1
For n2 = -1 To 1
q1 = q(s) + n1 * h
p1 = p(s) + n2 * h
pp = 0
If q1 < 0 Then pp = 1
If pp = 1 Then q1 = 0
u1 = th(s + 1) * Log(q1 + 1) - p1
If pp = 1 Then u1 = -999
w(s, n1, n2) = u1
Next
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
v(1, n1, n2) = rev(1, n1, n2)
Next
Next
For s = 2 To 100
For n1 = -1 To 1
For n2 = -1 To 1
r1 = rev(s, n1, n2)
u1 = u(s, n1, n2)
maxv = -999
For m1 = -1 To 1
For m2 = -1 To 1
v1 = r1 + v(s - 1, m1, m2)
w1 = w(s - 1, m1, m2)
If w1 > u1 Then v1 = -999
If v1 > maxv Then nx1 = m1
If v1 > maxv Then nx2 = m2
If v1 > maxv Then maxv = v1
Next
Next
goto1(s, n1, n2) = nx1
goto2(s, n1, n2) = nx2
v(s, n1, n2) = maxv
Next
Next
Next
maxv = -999
For n1 = -1 To 1
For n2 = -1 To 1
If v(100, n1, n2) > maxv Then nx1 = n1
If v(100, n1, n2) > maxv Then nx2 = n2
If v(100, n1, n2) > maxv Then maxv = v(100, n1, n2)
Next
Next
op1(100) = nx1
op2(100) = nx2
For j = 1 To 99
s = 100 - j
op1(s) = goto1(s + 1, op1(s + 1), op2(s + 1))
op2(s) = goto2(s + 1, op1(s + 1), op2(s + 1))
Next
e = 0
For s = 1 To 100
e = e + op1(s) ^ 2 + op2(s) ^ 2
Next
For s = 1 To 100
q(s) = q(s) + op1(s) * h
p(s) = p(s) + op2(s) * h
Next
t = t + 1
If e < 1 Then h = h / 2
If h < 10 ^ (-5) Then t = 10000
Debug.Print t, e, maxv
Loop
For s = 1 To 99
q1 = q(s + 1) - q(s)
p1 = p(s + 1) - p(s)
If q1 > 0 Then Debug.Print q(s), p1 / q1
Next

End Sub