けｒ - プログラム倉庫

Private Sub Command1_Click()
Dim s As Single
Dim m As Single
Dim th1(1 To 100) As Single
Dim th2(1 To 100) As Single
Dim y1(1 To 10, 1 To 10) As Single
Dim y2(1 To 10, 1 To 10) As Single
Dim c(1 To 10, 1 To 10) As Single
Dim u(1 To 10, -1 To 1, -1 To 1, -1 To 1) As Single
Dim w(1 To 9, -1 To 1, -1 To 1, -1 To 1) As Single
Dim v(1 To 9, -1 To 1, -1 To 1, -1 To 1, -5 To 5) As Single
Dim goto1(1 To 9, -1 To 1, -1 To 1, -1 To 1, -5 To 5) As Single
Dim goto2(1 To 9, -1 To 1, -1 To 1, -1 To 1, -5 To 5) As Single
Dim goto3(1 To 9, -1 To 1, -1 To 1, -1 To 1, -5 To 5) As Single
Dim endv(-1 To 1, -1 To 1, -1 To 1) As Single
Dim end1(-1 To 1, -1 To 1, -1 To 1) As Single
Dim end2(-1 To 1, -1 To 1, -1 To 1) As Single
Dim end3(-1 To 1, -1 To 1, -1 To 1) As Single
Dim tl As Single
Dim tk As Single
Dim tr As Single
Dim s1 As Single
Dim c1 As Single
Dim w1 As Single
Dim w2 As Single
Dim op1(1 To 10) As Single
Dim op2(1 To 10) As Single
Dim op3(1 To 10) As Single

For s = 1 To 10
th1(s) = 0.2 * s
th2(s) = 0.1 * s
Next
Open "c:/lupin.txt" For Input As #2
Do Until EOF(2)
Input #2, a1, a2, a3, a4, a5
s1 = a1
s2 = a2
c(s1, s2) = a3
y1(s1, s2) = a4
y2(s1, s2) = a5
Loop
Close #2
Dim n1 As Single
Dim n2 As Single
Dim n3 As Single
h = 0.001
t = 0
Do Until t > 100
For s1 = 1 To 10
c1 = c(s1, 2)
l1 = y1(s1, 2) / th1(s1)
l2 = y2(s1, 2) / th2(1)
pp = 0
If l1 > 0.99 Then pp = 1
If l2 > 0.99 Then pp = 1
If pp = 1 Then l1 = 0.5
If pp = 1 Then l2 = 0.5
w1 = Log(c1) + Log(1 - l1) + Log(1 - l2)
If pp = 1 Then w1 = -999
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
c1 = c(s1, 1) + n1 * h
l1 = (y1(s1, 1) + n2 * h) / th1(s1)
l2 = (y2(s1, 1) + n3 * h) / th2(1)
pp = 0
If l1 > 0.99 Then pp = 1
If l2 > 0.99 Then pp = 1
If l1 < 0 Then pp = 1
If l2 < 0 Then pp = 1
If pp = 1 Then l1 = 0.5
If pp = 1 Then l2 = 0.5
u1 = Log(c1) + Log(1 - l1) + Log(1 - l2)
If pp = 1 Then u1 = -999
If w1 > u1 Then u1 = -999
u(s1, n1, n2, n3) = u1
Next
Next
Next
Next
For s1 = 1 To 9
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
c1 = c(s1, 1) + n1 * h
l1 = (y1(s1, 1) + n2 * h) / th1(s1 + 1)
l2 = (y2(s1, 1) + n3 * h) / th2(1)
pp = 0
If l1 > 0.99 Then pp = 1
If l2 > 0.99 Then pp = 1
If l1 < 0 Then pp = 1
If l2 < 0 Then pp = 1
If pp = 1 Then l1 = 0.5
If pp = 1 Then l2 = 0.5
u1 = Log(c1) + Log(1 - l1) + Log(1 - l2)
If pp = 1 Then u1 = -999
w(s1, n1, n2, n3) = u1
Next
Next
Next
Next
For s1 = 1 To 9
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
For q = -5 To 5
v(s1, n1, n2, n3, q) = -999
Next
Next
Next
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
q = n2 + n3 - n1
v(1, n1, n2, n3, q) = u(1, n1, n2, n3)
Next
Next
Next
For s1 = 2 To 9
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
For q = -5 To 5
u1 = u(s1, n1, n2, n3)
qx = q + n1 - n2 - n3
pp = 0
If qx > 5 Then pp = 1
If qx < -5 Then pp = 1
If pp = 1 Then qx = 0
vs = -999
For nx1 = -1 To 1
For nx2 = -1 To 1
For nx3 = -1 To 1
v1 = u1 + v(s1 - 1, nx1, nx2, nx3, qx)
w1 = w(s1 - 1, nx1, nx2, nx3)
If w1 > u1 Then v1 = -999
If v1 > vs Then ns1 = nx1
If v1 > vs Then ns2 = nx2
If v1 > vs Then ns3 = nx3
If v1 > vs Then vs = v1
Next
Next
Next
If pp = 1 Then vs = -999
v(s1, n1, n2, n3, q) = vs
goto1(s1, n1, n2, n3, q) = ns1
goto2(s1, n1, n2, n3, q) = ns2
goto3(s1, n1, n2, n3, q) = ns3
Next
Next
Next
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
u1 = u(10, n1, n2, n3)
qx = n1 - n2 - n3
vs = -999
For nx1 = -1 To 1
For nx2 = -1 To 1
For nx3 = -1 To 1
v1 = u1 + v(9, nx1, nx2, nx3, qx)
w1 = w(9, nx1, nx2, nx3)
If w1 > u1 Then v1 = -999
If v1 > vs Then ns1 = nx1
If v1 > vs Then ns2 = nx2
If v1 > vs Then ns3 = nx3
If v1 > vs Then vs = v1
Next
Next
Next
end1(n1, n2, n3) = ns1
end2(n1, n2, n3) = ns2
end3(n1, n2, n3) = ns3
endv(n1, n2, n3) = vs
Next
Next
Next
vs = -999
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
If endv(n1, n2, n3) > vs Then nx1 = n1
If endv(n1, n2, n3) > vs Then nx2 = n2
If endv(n1, n2, n3) > vs Then nx3 = n3
If endv(n1, n2, n3) > vs Then vs = endv(n1, n2, n3)
Next
Next
Next
op1(10) = nx1
op2(10) = nx2
op3(10) = nx3
q = op1(10) - op2(10) - op3(10)
op1(9) = end1(op1(10), op2(10), op3(10))
op2(9) = end2(op1(10), op2(10), op3(10))
op3(9) = end3(op1(10), op2(10), op3(10))
For j = 1 To 8
s1 = 10 - j
op1(s1 - 1) = goto1(s1, op2(s1), op2(s1), op3(s1), q)
op2(s1 - 1) = goto2(s1, op2(s1), op2(s1), op3(s1), q)
op3(s1 - 1) = goto3(s1, op2(s1), op2(s1), op3(s1), q)
q = q + op1(s1) - op2(s1) - op3(s1)
Debug.Print q
Next
e = 0
For s1 = 1 To 10
e = e + op1(s1) ^ 2 + op2(s1) ^ 2 + op3(s1) ^ 2
Next
Debug.Print t, e
For s1 = 1 To 10
c(s1, 1) = c(s1, 1) + op1(s1) * h
y1(s1, 1) = y1(s1, 1) + op2(s1) * h
y2(s1, 1) = y2(s1, 1) + op3(s1) * h
Next
If e < 1 Then t = 1000
t = t + 1
Loop
End Sub