たて たて - プログラム倉庫

Function check(s1 As Single, th1, th2, n As Single, c, y1, y2, x, h As Single) As Single
Dim ch As Single
Dim s2 As Single
Dim c1 As Single
Dim x1 As Single
Dim x2 As Single
Dim u1 As Single
ch = 0
For s2 = 1 To 9
c1 = c(s1, s2) + x(s1, s2, 1, n) * h
x1 = y1(s1, s2) + x(s1, s2, 2, n) * h
x2 = y2(s1, s2) + x(s1, s2, 3, n) * h
u1 = u(s1, s2, th1, th2, c1, x1, x2)
c1 = c(s1, s2 + 1) + x(s1, s2 + 1, 1, n) * h
x1 = y1(s1, s2 + 1) + x(s1, s2 + 1, 2, n) * h
x2 = y2(s1, s2 + 1) + x(s1, s2 + 1, 3, n) * h
u2 = u(s1, s2, th1, th2, c1, x1, x2)
If u2 > u1 Then ch = ch + 10
Next
check = ch
End Function
Function bcount(s1 As Single, n As Single, x) As Single
Dim sum1 As Single
Dim s2 As Single
sum1 = 0
For s2 = 1 To 10
sum1 = sum1 + x(s1, s2, 1, n) - x(s1, s2, 2, n) - x(s1, s2, 3, n)
Next
bcount = sum1
End Function

Function u(s1 As Single, s2 As Single, th1, th2, cp As Single, yp1 As Single, yp2 As Single) As Single
Dim lx As Single
Dim cx As Single
Dim px As Single
l1 = yp1 / th1(s1)
l2 = yp2 / th2(s2)
cx = cp
px = 0
If cx < 0.01 Then px = 1
If l1 > 0.99 Then px = 1
If l2 > 0.99 Then px = 1
If l1 < 0 Then px = 1
If l2 < 0 Then px = 1
If px = 1 Then cx = 0.5
If px = 1 Then l1 = 0.5
If px = 1 Then l2 = 0.5
ux = Log(cx) + Log(1 - l1) + Log(1 - l2)
If px = 1 Then ux = -999
u = ux
End Function
Private Sub Command1_Click()
Dim s2 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 x(1 To 10, 1 To 10, 1 To 3, 0 To 10) As Single
Dim gu(1 To 10, 0 To 10) As Single
Dim cn(1 To 10, 0 To 10) As Single
Dim v(1 To 10, 0 To 10, -1 To 1) As Single
Dim goton(1 To 10, 0 To 10, -1 To 1) As Single
Dim gotoq(1 To 10, 0 To 10, -1 To 1) As Single
Dim s1 As Single
Dim rank As Single
Dim s As Single
Dim r1 As Single
Dim x1 As Single
Dim c1 As Single
Dim x2 As Single
Dim t2 As Single
Dim n As Single
Dim h As Single
Dim op(1 To 10) As Single
Dim oq(1 To 10) As Single
Dim vs As Single
Dim q 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
t3 = 0
Do Until t3 > 100
For s1 = 1 To 10
For n = 1 To 10
t2 = 0
Do Until t2 > 100
t1 = 0
Do Until t1 > 100
For s2 = 1 To 10
For rank = 1 To 3
Randomize
r1 = Rnd()
x1 = 0
If r1 > 0.7 Then x1 = 1
If r1 < 0.3 Then x1 = -1
x(s1, s2, rank, n) = x1
Next
Next
cn(s1, n) = bcount(s1, n, x)
If cn(s1, n) = 1 Then t1 = 1000
If cn(s1, n) = 0 Then t1 = 1000
If cn(s1, n) = -1 Then t1 = 1000
t1 = t1 + 1
Loop
h = 0.001
ch = check(s1, th1, th2, n, c, y1, y2, x, h)
If ch < 10 Then t2 = 1000
t2 = t2 + 1
Loop
Next
Next
For s1 = 1 To 10
For n = 0 To 10
u1 = 0
For s2 = 1 To 10
c1 = c(s1, s2) + x(s1, s2, 1, n) * h
x1 = y1(s1, s2) + x(s1, s2, 2, n) * h
x2 = y2(s1, s2) + x(s1, s2, 3, n) * h
u1 = u1 + u(s1, s2, th1, th2, c1, x1, x2)
Next
gu(s1, n) = u1
Next
Next
s1 = 1
For n = 0 To 10
q = cn(s1, n)
v(s1, n, q) = gu(s1, n)
Next
For s1 = 2 To 10
For n = 0 To 10
For q = -1 To 1
qx = q - bcount(s1, n, x)
pp = 0
If qx > 1 Then pp = 1
If qx < -1 Then pp = 1
If pp = 1 Then qx = 0
vs = -999
For p = 0 To 10
de = 0
For s2 = 1 To 10
c1 = c(s1, s2) + x(s1, s2, 1, n) * h
x1 = y1(s1, s2) + x(s1, s2, 2, n) * h
x2 = y2(s1, s2) + x(s1, s2, 3, n) * h
u1 = u(s1, s2, th1, th2, c1, x1, x2)
For n2 = 1 To 10
c1 = c(s1 - 1, n2) + x(s1 - 1, n2, 1, p) * h
x1 = y1(s1 - 1, n2) + x(s1 - 1, n2, 2, p) * h
x2 = y2(s1 - 1, n2) + x(s1 - 1, n2, 3, p) * h
u2 = u(s1, s2, th1, th2, c1, x1, x2)
If u2 > u1 Then de = de + 10
Next
Next
v1 = gu(s1, n) + v(s1 - 1, p, qx)
If pp = 1 Then v1 = -999
If de > 5 Then v1 = -999
If v1 > vs Then qxs = qx
If v1 > vs Then nx = p
If v1 > vs Then vs = v1
Next
v(s1, n, q) = vs
goton(s1, n, q) = nx
gotoq(s1, n, q) = qxs
Next
Next
Next
For n = 0 To 10
For q = -1 To 1
If v(10, n, q) > -900 Then Debug.Print t3, n, q, v(10, n, q)
Next
Next
s1 = 10
maxv = -999
For n = 0 To 10
If v(s1, n, 0) > maxv Then nx = n
If v(s1, n, 0) > maxv Then maxv = v(s1, n, 0)
Next
op(10) = nx
oq(10) = 0
For j = 1 To 9
s1 = 11 - j
op(s1 - 1) = goton(s1, op(s1), oq(s1))
oq(s1 - 1) = gotoq(s1, op(s1), oq(s1))
Next
For s1 = 1 To 10
For s2 = 1 To 10
c(s1, s2) = c(s1, s2) + x(s1, s2, 1, op(s1)) * h
y1(s1, s2) = y1(s1, s2) + x(s1, s2, 2, op(s1)) * h
y2(s1, s2) = y2(s1, s2) + x(s1, s2, 3, op(s1)) * h
Next
Next
e = 0
For s1 = 1 To 10
e = e + op(s1) ^ 2
Next
Debug.Print t3, e, maxv
t3 = t3 + 1
Loop
End Sub