ひぃ＠ - プログラム倉庫

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 endv(-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
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.0001
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 vs = v1
Next
Next
Next
If pp = 1 Then vs = -999
v(s1, n1, n2, n3, q) = vs
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 vs = v1
Next
Next
Next
endv(n1, n2, n3) = vs
Debug.Print n1, n2, n3, endv(n1, n2, n3)
Next
Next
Next


End Sub